Commit | Line | Data |
---|---|---|
ce631299 DM |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org> | |
c086c5af | 3 | ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> |
ce631299 DM |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (guix build-system linux-module) | |
21 | #:use-module (guix store) | |
22 | #:use-module (guix utils) | |
23 | #:use-module (guix derivations) | |
24 | #:use-module (guix search-paths) | |
25 | #:use-module (guix build-system) | |
26 | #:use-module (guix build-system gnu) | |
27 | #:use-module (guix packages) | |
28 | #:use-module (ice-9 match) | |
29 | #:export (%linux-module-build-system-modules | |
30 | linux-module-build | |
31 | linux-module-build-system)) | |
32 | ||
33 | ;; Commentary: | |
34 | ;; | |
35 | ;; Code: | |
36 | ||
37 | (define %linux-module-build-system-modules | |
38 | ;; Build-side modules imported by default. | |
39 | `((guix build linux-module-build-system) | |
40 | ,@%gnu-build-system-modules)) | |
41 | ||
42 | (define (default-linux) | |
43 | "Return the default Linux package." | |
44 | ||
45 | ;; Do not use `@' to avoid introducing circular dependencies. | |
46 | (let ((module (resolve-interface '(gnu packages linux)))) | |
47 | (module-ref module 'linux-libre))) | |
48 | ||
c086c5af | 49 | (define (system->arch system) |
ce631299 | 50 | (let ((module (resolve-interface '(gnu packages linux)))) |
c086c5af | 51 | ((module-ref module 'system->linux-architecture) system))) |
ce631299 DM |
52 | |
53 | (define (make-linux-module-builder linux) | |
54 | (package | |
55 | (inherit linux) | |
56 | (name (string-append (package-name linux) "-module-builder")) | |
c086c5af MO |
57 | (inputs |
58 | `(("linux" ,linux))) | |
ce631299 DM |
59 | (arguments |
60 | (substitute-keyword-arguments (package-arguments linux) | |
61 | ((#:phases phases) | |
62 | `(modify-phases ,phases | |
63 | (replace 'build | |
64 | (lambda _ | |
65 | (invoke "make" "modules_prepare"))) | |
66 | (delete 'strip) ; faster. | |
67 | (replace 'install | |
88e13c25 | 68 | (lambda* (#:key inputs outputs #:allow-other-keys) |
ce631299 DM |
69 | (let* ((out (assoc-ref outputs "out")) |
70 | (out-lib-build (string-append out "/lib/modules/build"))) | |
2be5c265 | 71 | ;; Delete some huge items that we probably don't need. |
8d003ca3 MO |
72 | ;; TODO: Only preserve the minimum, i.e. [Kbuild], Kconfig, |
73 | ;; scripts, include, ".config". | |
ce631299 | 74 | (copy-recursively "." out-lib-build) |
2be5c265 DM |
75 | (for-each (lambda (name) |
76 | (when (file-exists? name) | |
77 | (delete-file-recursively name))) | |
78 | (map (lambda (name) | |
79 | (string-append out-lib-build "/" name)) | |
80 | '("arch" ; 137 MB | |
81 | ;"tools" ; 44 MB ; Note: is built by our 'build phase. | |
82 | "tools/testing" ; 14 MB | |
83 | "tools/perf" ; 17 MB | |
84 | "drivers" ; 600 MB | |
85 | "Documentation" ; 52 MB | |
86 | "fs" ; 43 MB | |
87 | "net" ; 33 MB | |
88 | "samples" ; 2 MB | |
89 | "sound"))) ; 40 MB | |
90 | ;; Reinstate arch/**/dts since "scripts/dtc" depends on it. | |
91 | ;; Reinstate arch/**/include directories. | |
92 | ;; Reinstate arch/**/Makefile. | |
93 | ;; Reinstate arch/**/module.lds. | |
94 | (for-each | |
95 | (lambda (name) | |
96 | (mkdir-p (dirname (string-append out-lib-build "/" name))) | |
97 | (copy-recursively name | |
98 | (string-append out-lib-build "/" name))) | |
99 | (append (find-files "arch" "^(dts|include)$" #:directories? #t) | |
100 | (find-files "arch" "^(Makefile|module.lds)$"))) | |
88e13c25 DM |
101 | (let* ((linux (assoc-ref inputs "linux"))) |
102 | (install-file (string-append linux "/System.map") | |
103 | out-lib-build) | |
104 | (let ((source (string-append linux "/Module.symvers"))) | |
2be5c265 | 105 | (when (file-exists? source) |
88e13c25 | 106 | (install-file source out-lib-build)))) |
ce631299 DM |
107 | #t))))))))) |
108 | ||
109 | (define* (lower name | |
110 | #:key source inputs native-inputs outputs | |
111 | system target | |
112 | (linux (default-linux)) | |
113 | #:allow-other-keys | |
114 | #:rest arguments) | |
115 | "Return a bag for NAME." | |
116 | (define private-keywords | |
c086c5af MO |
117 | `(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs |
118 | ,@(if target '() '(#:target)))) | |
119 | ||
120 | (bag | |
121 | (name name) | |
122 | (system system) (target target) | |
123 | (build-inputs `(,@(if source | |
124 | `(("source" ,source)) | |
125 | '()) | |
126 | ,@native-inputs | |
127 | ;; TODO: Remove "gmp", "mpfr", "mpc" since they are | |
128 | ;; only needed to compile the gcc plugins. Maybe | |
129 | ;; remove "flex", "bison", "elfutils", "perl", | |
130 | ;; "openssl". That leaves very little ("bc", "gcc", | |
131 | ;; "kmod"). | |
132 | ,@(package-native-inputs linux) | |
133 | ,@(if target | |
134 | ;; Use the standard cross inputs of | |
135 | ;; 'gnu-build-system'. | |
136 | (standard-cross-packages target 'host) | |
137 | '()) | |
138 | ;; Keep the standard inputs of 'gnu-build-system'. | |
139 | ,@(standard-packages))) | |
140 | (host-inputs `(,@inputs | |
141 | ("linux" ,linux) | |
142 | ("linux-module-builder" | |
143 | ,(make-linux-module-builder linux)))) | |
144 | (target-inputs (if target | |
145 | (standard-cross-packages target 'target) | |
146 | '())) | |
147 | (outputs outputs) | |
148 | (build (if target linux-module-build-cross linux-module-build)) | |
149 | (arguments (strip-keyword-arguments private-keywords arguments)))) | |
ce631299 DM |
150 | |
151 | (define* (linux-module-build store name inputs | |
152 | #:key | |
c086c5af | 153 | target |
ce631299 DM |
154 | (search-paths '()) |
155 | (tests? #t) | |
156 | (phases '(@ (guix build linux-module-build-system) | |
157 | %standard-phases)) | |
158 | (outputs '("out")) | |
f51fd97e | 159 | (make-flags ''()) |
ce631299 DM |
160 | (system (%current-system)) |
161 | (guile #f) | |
87a02810 | 162 | (substitutable? #t) |
ce631299 DM |
163 | (imported-modules |
164 | %linux-module-build-system-modules) | |
165 | (modules '((guix build linux-module-build-system) | |
166 | (guix build utils)))) | |
167 | "Build SOURCE using LINUX, and with INPUTS." | |
168 | (define builder | |
169 | `(begin | |
170 | (use-modules ,@modules) | |
171 | (linux-module-build #:name ,name | |
172 | #:source ,(match (assoc-ref inputs "source") | |
173 | (((? derivation? source)) | |
174 | (derivation->output-path source)) | |
175 | ((source) | |
176 | source) | |
177 | (source | |
178 | source)) | |
179 | #:search-paths ',(map search-path-specification->sexp | |
180 | search-paths) | |
181 | #:phases ,phases | |
182 | #:system ,system | |
c086c5af MO |
183 | #:target ,target |
184 | #:arch ,(system->arch (or target system)) | |
ce631299 DM |
185 | #:tests? ,tests? |
186 | #:outputs %outputs | |
f51fd97e | 187 | #:make-flags ,make-flags |
ce631299 DM |
188 | #:inputs %build-inputs))) |
189 | ||
190 | (define guile-for-build | |
191 | (match guile | |
192 | ((? package?) | |
193 | (package-derivation store guile system #:graft? #f)) | |
194 | (#f ; the default | |
195 | (let* ((distro (resolve-interface '(gnu packages commencement))) | |
196 | (guile (module-ref distro 'guile-final))) | |
197 | (package-derivation store guile system #:graft? #f))))) | |
198 | ||
199 | (build-expression->derivation store name builder | |
200 | #:system system | |
201 | #:inputs inputs | |
202 | #:modules imported-modules | |
203 | #:outputs outputs | |
87a02810 EF |
204 | #:guile-for-build guile-for-build |
205 | #:substitutable? substitutable?)) | |
ce631299 | 206 | |
c086c5af MO |
207 | (define* (linux-module-build-cross |
208 | store name | |
209 | #:key | |
210 | target native-drvs target-drvs | |
211 | (guile #f) | |
212 | (outputs '("out")) | |
f51fd97e | 213 | (make-flags ''()) |
c086c5af MO |
214 | (search-paths '()) |
215 | (native-search-paths '()) | |
216 | (tests? #f) | |
217 | (phases '(@ (guix build linux-module-build-system) | |
218 | %standard-phases)) | |
219 | (system (%current-system)) | |
220 | (substitutable? #t) | |
221 | (imported-modules | |
222 | %linux-module-build-system-modules) | |
223 | (modules '((guix build linux-module-build-system) | |
224 | (guix build utils)))) | |
225 | (define builder | |
226 | `(begin | |
227 | (use-modules ,@modules) | |
228 | (let () | |
229 | (define %build-host-inputs | |
230 | ',(map (match-lambda | |
231 | ((name (? derivation? drv) sub ...) | |
232 | `(,name . ,(apply derivation->output-path drv sub))) | |
233 | ((name path) | |
234 | `(,name . ,path))) | |
235 | native-drvs)) | |
236 | ||
237 | (define %build-target-inputs | |
238 | ',(map (match-lambda | |
239 | ((name (? derivation? drv) sub ...) | |
240 | `(,name . ,(apply derivation->output-path drv sub))) | |
241 | ((name (? package? pkg) sub ...) | |
242 | (let ((drv (package-cross-derivation store pkg | |
243 | target system))) | |
244 | `(,name . ,(apply derivation->output-path drv sub)))) | |
245 | ((name path) | |
246 | `(,name . ,path))) | |
247 | target-drvs)) | |
248 | ||
249 | (linux-module-build #:name ,name | |
250 | #:source ,(match (assoc-ref native-drvs "source") | |
251 | (((? derivation? source)) | |
252 | (derivation->output-path source)) | |
253 | ((source) | |
254 | source) | |
255 | (source | |
256 | source)) | |
257 | #:system ,system | |
258 | #:target ,target | |
259 | #:arch ,(system->arch (or target system)) | |
260 | #:outputs %outputs | |
f51fd97e | 261 | #:make-flags ,make-flags |
c086c5af MO |
262 | #:inputs %build-target-inputs |
263 | #:native-inputs %build-host-inputs | |
264 | #:search-paths | |
265 | ',(map search-path-specification->sexp | |
266 | search-paths) | |
267 | #:native-search-paths | |
268 | ',(map | |
269 | search-path-specification->sexp | |
270 | native-search-paths) | |
271 | #:phases ,phases | |
272 | #:tests? ,tests?)))) | |
273 | ||
274 | (define guile-for-build | |
275 | (match guile | |
276 | ((? package?) | |
277 | (package-derivation store guile system #:graft? #f)) | |
278 | (#f ; the default | |
279 | (let* ((distro (resolve-interface '(gnu packages commencement))) | |
280 | (guile (module-ref distro 'guile-final))) | |
281 | (package-derivation store guile system #:graft? #f))))) | |
282 | ||
283 | (build-expression->derivation store name builder | |
284 | #:system system | |
285 | #:inputs (append native-drvs target-drvs) | |
286 | #:outputs outputs | |
287 | #:modules imported-modules | |
288 | #:guile-for-build guile-for-build | |
289 | #:substitutable? substitutable?)) | |
290 | ||
ce631299 DM |
291 | (define linux-module-build-system |
292 | (build-system | |
293 | (name 'linux-module) | |
294 | (description "The Linux module build system") | |
295 | (lower lower))) | |
296 | ||
297 | ;;; linux-module.scm ends here |