Commit | Line | Data |
---|---|---|
fcaa5f44 | 1 | ;;; GNU Guix --- Functional package management for GNU |
4cd386af | 2 | ;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org> |
a5e13c3b | 3 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> |
4f8b9d1a | 4 | ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org> |
fcaa5f44 LC |
5 | ;;; |
6 | ;;; This file is part of GNU Guix. | |
7 | ;;; | |
8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
9 | ;;; under the terms of the GNU General Public License as published by | |
10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
11 | ;;; your option) any later version. | |
12 | ;;; | |
13 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;;; GNU General Public License for more details. | |
17 | ;;; | |
18 | ;;; You should have received a copy of the GNU General Public License | |
19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | (define-module (gnu build linux-modules) | |
22 | #:use-module (guix elf) | |
8661ad27 | 23 | #:use-module (guix glob) |
a5e13c3b | 24 | #:use-module (guix build syscalls) |
5c79f238 DM |
25 | #:use-module ((guix build utils) #:select (find-files invoke)) |
26 | #:use-module (guix build union) | |
755f365b | 27 | #:autoload (zlib) (call-with-gzip-input-port) |
fcaa5f44 LC |
28 | #:use-module (rnrs io ports) |
29 | #:use-module (rnrs bytevectors) | |
30 | #:use-module (srfi srfi-1) | |
f347fb79 | 31 | #:use-module (srfi srfi-11) |
fcaa5f44 | 32 | #:use-module (srfi srfi-26) |
5c79f238 | 33 | #:use-module (ice-9 ftw) |
fcaa5f44 LC |
34 | #:use-module (ice-9 vlist) |
35 | #:use-module (ice-9 match) | |
8661ad27 | 36 | #:use-module (ice-9 rdelim) |
c85ccf60 | 37 | #:autoload (ice-9 pretty-print) (pretty-print) |
fcaa5f44 LC |
38 | #:export (dot-ko |
39 | ensure-dot-ko | |
c85ccf60 | 40 | module-formal-name |
8b2219d8 | 41 | module-aliases |
fcaa5f44 | 42 | module-dependencies |
1a5f4662 | 43 | module-soft-dependencies |
411959be | 44 | normalize-module-name |
d2a1cf45 | 45 | file-name->module-name |
fcd068e9 | 46 | find-module-file |
fcaa5f44 LC |
47 | recursive-module-dependencies |
48 | modules-loaded | |
49 | module-loaded? | |
50 | load-linux-module* | |
e1a9a7f2 | 51 | load-linux-modules-from-directory |
fcaa5f44 | 52 | |
8661ad27 LC |
53 | current-module-debugging-port |
54 | ||
55 | device-module-aliases | |
56 | known-module-aliases | |
4cd386af | 57 | matching-modules |
4f8b9d1a DM |
58 | missing-modules |
59 | ||
c85ccf60 | 60 | write-module-name-database |
2a693b69 | 61 | write-module-alias-database |
5c79f238 DM |
62 | write-module-device-database |
63 | ||
64 | make-linux-module-directory)) | |
fcaa5f44 LC |
65 | |
66 | ;;; Commentary: | |
67 | ;;; | |
68 | ;;; Tools to deal with Linux kernel modules. | |
69 | ;;; | |
70 | ;;; Code: | |
71 | ||
72 | (define current-module-debugging-port | |
73 | (make-parameter (%make-void-port "w"))) | |
74 | ||
75 | (define (section-contents elf section) | |
76 | "Return the contents of SECTION in ELF as a bytevector." | |
f43d2dcd LC |
77 | (let ((contents (make-bytevector (elf-section-size section)))) |
78 | (bytevector-copy! (elf-bytes elf) (elf-section-offset section) | |
fcaa5f44 | 79 | contents 0 |
f43d2dcd | 80 | (elf-section-size section)) |
fcaa5f44 LC |
81 | contents)) |
82 | ||
83 | (define %not-nul | |
84 | (char-set-complement (char-set #\nul))) | |
85 | ||
86 | (define (nul-separated-string->list str) | |
87 | "Split STR at occurrences of the NUL character and return the resulting | |
88 | string list." | |
89 | (string-tokenize str %not-nul)) | |
90 | ||
91 | (define (key=value->pair str) | |
92 | "Assuming STR has the form \"KEY=VALUE\", return a pair like (KEY | |
93 | . \"VALUE\")." | |
94 | (let ((= (string-index str #\=))) | |
95 | (cons (string->symbol (string-take str =)) | |
96 | (string-drop str (+ 1 =))))) | |
97 | ||
755f365b MO |
98 | ;; Matches kernel modules, without compression, with GZIP compression or with |
99 | ;; XZ compression. | |
100 | (define module-regex "\\.ko(\\.gz|\\.xz)?$") | |
101 | ||
fcaa5f44 LC |
102 | (define (modinfo-section-contents file) |
103 | "Return the contents of the '.modinfo' section of FILE as a list of | |
104 | key/value pairs.." | |
755f365b MO |
105 | (define (get-bytevector file) |
106 | (cond | |
107 | ((string-suffix? ".ko.gz" file) | |
108 | (let ((port (open-file file "r0"))) | |
109 | (dynamic-wind | |
110 | (lambda () | |
111 | #t) | |
112 | (lambda () | |
113 | (call-with-gzip-input-port port get-bytevector-all)) | |
114 | (lambda () | |
115 | (close-port port))))) | |
116 | (else | |
117 | (call-with-input-file file get-bytevector-all)))) | |
118 | ||
119 | (let* ((bv (get-bytevector file)) | |
fcaa5f44 | 120 | (elf (parse-elf bv)) |
f43d2dcd LC |
121 | (section (elf-section-by-name elf ".modinfo")) |
122 | (modinfo (section-contents elf section))) | |
fcaa5f44 LC |
123 | (map key=value->pair |
124 | (nul-separated-string->list (utf8->string modinfo))))) | |
125 | ||
126 | (define %not-comma | |
127 | (char-set-complement (char-set #\,))) | |
128 | ||
c85ccf60 LC |
129 | (define (module-formal-name file) |
130 | "Return the module name of FILE as it appears in its info section. Usually | |
131 | the module name is the same as the base name of FILE, modulo hyphens and minus | |
755f365b | 132 | the \".ko[.gz|.xz]\" extension." |
c85ccf60 LC |
133 | (match (assq 'name (modinfo-section-contents file)) |
134 | (('name . name) name) | |
135 | (#f #f))) | |
136 | ||
fcaa5f44 LC |
137 | (define (module-dependencies file) |
138 | "Return the list of modules that FILE depends on. The returned list | |
139 | contains module names, not actual file names." | |
140 | (let ((info (modinfo-section-contents file))) | |
141 | (match (assq 'depends info) | |
142 | (('depends . what) | |
143 | (string-tokenize what %not-comma))))) | |
144 | ||
1a5f4662 DM |
145 | (define not-softdep-whitespace |
146 | (char-set-complement (char-set #\space #\tab))) | |
147 | ||
148 | (define (module-soft-dependencies file) | |
f347fb79 DM |
149 | "Return the list of modules that can be preloaded, and then the list of |
150 | modules that can be postloaded, of the soft dependencies of module FILE." | |
1a5f4662 DM |
151 | ;; TEXT: "pre: baz blubb foo post: bax bar" |
152 | (define (parse-softdep text) | |
153 | (let loop ((value '()) | |
154 | (tokens (string-tokenize text not-softdep-whitespace)) | |
155 | (section #f)) | |
156 | (match tokens | |
157 | ((token rest ...) | |
158 | (if (string=? (string-take-right token 1) ":") ; section | |
519be98c | 159 | (loop value rest (string-trim-both (string-drop-right token 1))) |
1a5f4662 DM |
160 | (loop (cons (cons section token) value) rest section))) |
161 | (() | |
162 | value)))) | |
163 | ||
164 | ;; Note: Multiple 'softdep sections are allowed. | |
f347fb79 DM |
165 | (let* ((info (modinfo-section-contents file)) |
166 | (entries (concatenate | |
167 | (filter-map (match-lambda | |
168 | (('softdep . value) | |
169 | (parse-softdep value)) | |
170 | (_ #f)) | |
171 | (modinfo-section-contents file))))) | |
172 | (let-values (((pres posts) | |
173 | (partition (match-lambda | |
174 | (("pre" . _) #t) | |
175 | (("post" . _) #f)) | |
176 | entries))) | |
177 | (values (map (match-lambda | |
178 | ((_ . value) value)) | |
179 | pres) | |
180 | (map (match-lambda | |
181 | ((_ . value) value)) | |
182 | posts))))) | |
1a5f4662 | 183 | |
8b2219d8 DM |
184 | (define (module-aliases file) |
185 | "Return the list of aliases of module FILE." | |
186 | (let ((info (modinfo-section-contents file))) | |
187 | (filter-map (match-lambda | |
188 | (('alias . value) | |
189 | value) | |
190 | (_ #f)) | |
191 | (modinfo-section-contents file)))) | |
192 | ||
755f365b MO |
193 | (define (strip-extension filename) |
194 | (let ((extension (string-index filename #\.))) | |
195 | (if extension | |
196 | (string-take filename extension) | |
197 | filename))) | |
198 | ||
199 | (define (dot-ko name compression) | |
200 | (let ((suffix (match compression | |
201 | ('xz ".ko.xz") | |
202 | ('gzip ".ko.gz") | |
203 | (else ".ko")))) | |
204 | (string-append name suffix))) | |
205 | ||
206 | (define (ensure-dot-ko name compression) | |
207 | "Return NAME with a '.ko[.gz|.xz]' suffix appended, unless it already has | |
208 | it." | |
209 | (if (string-contains name ".ko") | |
fcaa5f44 | 210 | name |
755f365b | 211 | (dot-ko name compression))) |
fcaa5f44 | 212 | |
5c7dd5ac LC |
213 | (define (normalize-module-name module) |
214 | "Return the \"canonical\" name for MODULE, replacing hyphens with | |
215 | underscores." | |
216 | ;; See 'modname_normalize' in libkmod. | |
217 | (string-map (lambda (chr) | |
218 | (case chr | |
219 | ((#\-) #\_) | |
220 | (else chr))) | |
221 | module)) | |
222 | ||
7ba903b6 | 223 | (define (file-name->module-name file) |
755f365b MO |
224 | "Return the module name corresponding to FILE, stripping the trailing |
225 | '.ko[.gz|.xz]' and normalizing it." | |
226 | (normalize-module-name (strip-extension (basename file)))) | |
7ba903b6 | 227 | |
fcd068e9 LC |
228 | (define (find-module-file directory module) |
229 | "Lookup module NAME under DIRECTORY, and return its absolute file name. | |
230 | NAME can be a file name with or without '.ko', or it can be a module name. | |
4db7a9dc | 231 | Raise an error if it could not be found. |
fcd068e9 LC |
232 | |
233 | Module names can differ from file names in interesting ways; for instance, | |
234 | module names usually (always?) use underscores as the inter-word separator, | |
235 | whereas file names often, but not always, use hyphens. Examples: | |
236 | \"usb-storage.ko\", \"serpent_generic.ko\"." | |
237 | (define names | |
238 | ;; List of possible file names. XXX: It would of course be cleaner to | |
239 | ;; have a database that maps module names to file names and vice versa, | |
240 | ;; but everyone seems to be doing hacks like this one. Oh well! | |
755f365b MO |
241 | (delete-duplicates |
242 | (list module | |
243 | (normalize-module-name module) | |
244 | (string-map (lambda (chr) ;converse of 'normalize-module-name' | |
245 | (case chr | |
246 | ((#\_) #\-) | |
247 | (else chr))) | |
248 | module)))) | |
fcd068e9 LC |
249 | |
250 | (match (find-files directory | |
251 | (lambda (file stat) | |
755f365b MO |
252 | (member (strip-extension |
253 | (basename file)) names))) | |
fcd068e9 LC |
254 | ((file) |
255 | file) | |
256 | (() | |
4db7a9dc | 257 | (error "kernel module not found" module directory)) |
fcd068e9 LC |
258 | ((_ ...) |
259 | (error "several modules by that name" module directory)))) | |
260 | ||
fcaa5f44 LC |
261 | (define* (recursive-module-dependencies files |
262 | #:key (lookup-module dot-ko)) | |
263 | "Return the topologically-sorted list of file names of the modules depended | |
264 | on by FILES, recursively. File names of modules are determined by applying | |
265 | LOOKUP-MODULE to the module name." | |
266 | (let loop ((files files) | |
267 | (result '()) | |
268 | (visited vlist-null)) | |
269 | (match files | |
270 | (() | |
271 | (delete-duplicates (reverse result))) | |
272 | ((head . tail) | |
273 | (let* ((visited? (vhash-assoc head visited)) | |
274 | (deps (if visited? | |
275 | '() | |
276 | (map lookup-module (module-dependencies head)))) | |
277 | (visited (if visited? | |
278 | visited | |
279 | (vhash-cons head #t visited)))) | |
280 | (loop (append deps tail) | |
281 | (append result deps) visited)))))) | |
282 | ||
283 | (define %not-newline | |
284 | (char-set-complement (char-set #\newline))) | |
285 | ||
286 | (define (modules-loaded) | |
287 | "Return the list of names of currently loaded Linux modules." | |
288 | (let* ((contents (call-with-input-file "/proc/modules" | |
289 | get-string-all)) | |
290 | (lines (string-tokenize contents %not-newline))) | |
291 | (match (map string-tokenize lines) | |
292 | (((modules . _) ...) | |
293 | modules)))) | |
294 | ||
7ba903b6 LC |
295 | (define (module-black-list) |
296 | "Return the black list of modules that must not be loaded. This black list | |
297 | is specified using 'modprobe.blacklist=MODULE1,MODULE2,...' on the kernel | |
5c7dd5ac LC |
298 | command line; it is honored by libkmod for users that pass |
299 | 'KMOD_PROBE_APPLY_BLACKLIST', which includes 'modprobe --use-blacklist' and | |
300 | udev." | |
7ba903b6 LC |
301 | (define parameter |
302 | "modprobe.blacklist=") | |
303 | ||
304 | (let ((command (call-with-input-file "/proc/cmdline" | |
305 | get-string-all))) | |
306 | (append-map (lambda (arg) | |
307 | (if (string-prefix? parameter arg) | |
308 | (string-tokenize (string-drop arg (string-length parameter)) | |
309 | %not-comma) | |
310 | '())) | |
311 | (string-tokenize command)))) | |
312 | ||
fcaa5f44 LC |
313 | (define (module-loaded? module) |
314 | "Return #t if MODULE is already loaded. MODULE must be a Linux module name, | |
315 | not a file name." | |
316 | (member module (modules-loaded))) | |
317 | ||
318 | (define* (load-linux-module* file | |
319 | #:key | |
320 | (recursive? #t) | |
7ba903b6 LC |
321 | (lookup-module dot-ko) |
322 | (black-list (module-black-list))) | |
755f365b MO |
323 | "Load Linux module from FILE, the name of a '.ko[.gz|.xz]' file; return true |
324 | on success, false otherwise. When RECURSIVE? is true, load its dependencies | |
7ba903b6 LC |
325 | first (à la 'modprobe'.) The actual files containing modules depended on are |
326 | obtained by calling LOOKUP-MODULE with the module name. Modules whose name | |
327 | appears in BLACK-LIST are not loaded." | |
7ba903b6 LC |
328 | (define (black-listed? module) |
329 | (let ((result (member module black-list))) | |
330 | (when result | |
331 | (format (current-module-debugging-port) | |
332 | "not loading module '~a' because it's black-listed~%" | |
333 | module)) | |
334 | result)) | |
335 | ||
336 | (define (load-dependencies file) | |
337 | (let ((dependencies (module-dependencies file))) | |
675e81a0 LC |
338 | (every (cut load-linux-module* <> |
339 | #:lookup-module lookup-module | |
340 | #:black-list black-list) | |
7ba903b6 LC |
341 | (map lookup-module dependencies)))) |
342 | ||
343 | (and (not (black-listed? (file-name->module-name file))) | |
344 | (or (not recursive?) | |
345 | (load-dependencies file)) | |
3c14e7e6 | 346 | (let ((fd #f)) |
7ba903b6 LC |
347 | (format (current-module-debugging-port) |
348 | "loading Linux module from '~a'...~%" file) | |
349 | ||
350 | (catch 'system-error | |
351 | (lambda () | |
3c14e7e6 LC |
352 | (set! fd (open-fdes file O_RDONLY)) |
353 | (load-linux-module/fd fd) | |
354 | (close-fdes fd) | |
355 | #t) | |
7ba903b6 LC |
356 | (lambda args |
357 | ;; If this module was already loaded and we're in modprobe style, ignore | |
358 | ;; the error. | |
3c14e7e6 | 359 | (when fd (close-fdes fd)) |
7ba903b6 LC |
360 | (or (and recursive? (= EEXIST (system-error-errno args))) |
361 | (apply throw args))))))) | |
fcaa5f44 | 362 | |
e1a9a7f2 LC |
363 | (define (load-linux-modules-from-directory modules directory) |
364 | "Load MODULES and their dependencies from DIRECTORY, a directory containing | |
365 | the '.ko' files. The '.ko' suffix is automatically added to MODULES if | |
366 | needed." | |
c85ccf60 LC |
367 | (define module-name->file-name |
368 | (module-name-lookup directory)) | |
e1a9a7f2 | 369 | |
c85ccf60 LC |
370 | (for-each (lambda (module) |
371 | (load-linux-module* (module-name->file-name module) | |
372 | #:lookup-module module-name->file-name)) | |
373 | modules)) | |
e1a9a7f2 | 374 | |
8661ad27 LC |
375 | \f |
376 | ;;; | |
377 | ;;; Device modules. | |
378 | ;;; | |
379 | ||
380 | ;; Copied from (guix utils). FIXME: Factorize. | |
381 | (define (readlink* file) | |
382 | "Call 'readlink' until the result is not a symlink." | |
383 | (define %max-symlink-depth 50) | |
384 | ||
385 | (let loop ((file file) | |
386 | (depth 0)) | |
387 | (define (absolute target) | |
388 | (if (absolute-file-name? target) | |
389 | target | |
390 | (string-append (dirname file) "/" target))) | |
391 | ||
392 | (if (>= depth %max-symlink-depth) | |
393 | file | |
394 | (call-with-values | |
395 | (lambda () | |
396 | (catch 'system-error | |
397 | (lambda () | |
398 | (values #t (readlink file))) | |
399 | (lambda args | |
400 | (let ((errno (system-error-errno args))) | |
401 | (if (or (= errno EINVAL)) | |
402 | (values #f file) | |
403 | (apply throw args)))))) | |
404 | (lambda (success? target) | |
405 | (if success? | |
406 | (loop (absolute target) (+ depth 1)) | |
407 | file)))))) | |
408 | ||
409 | ;; See 'major' and 'minor' in <sys/sysmacros.h>. | |
410 | ||
411 | (define (stat->device-major st) | |
412 | (ash (logand #xfff00 (stat:rdev st)) -8)) | |
413 | ||
414 | (define (stat->device-minor st) | |
415 | (logand #xff (stat:rdev st))) | |
416 | ||
417 | (define %not-slash | |
418 | (char-set-complement (char-set #\/))) | |
419 | ||
420 | (define (read-uevent port) | |
421 | "Read a /sys 'uevent' file from PORT and return an alist where each car is a | |
422 | key such as 'MAJOR or 'DEVTYPE and each cdr is the corresponding value." | |
423 | (let loop ((result '())) | |
424 | (match (read-line port) | |
425 | ((? eof-object?) | |
426 | (reverse result)) | |
427 | (line | |
428 | (loop (cons (key=value->pair line) result)))))) | |
429 | ||
430 | (define (device-module-aliases device) | |
431 | "Return the list of module aliases required by DEVICE, a /dev file name, as | |
432 | in this example: | |
433 | ||
434 | (device-module-aliases \"/dev/sda\") | |
435 | => (\"scsi:t-0x00\" \"pci:v00008086d00009D03sv0000103Csd000080FAbc01sc06i01\") | |
436 | ||
437 | The modules corresponding to these aliases can then be found using | |
438 | 'matching-modules'." | |
439 | ;; The approach is adapted from | |
440 | ;; <https://unix.stackexchange.com/questions/97676/how-to-find-the-driver-module-associated-with-a-device-on-linux>. | |
441 | (let* ((st (stat device)) | |
442 | (type (stat:type st)) | |
443 | (major (stat->device-major st)) | |
444 | (minor (stat->device-minor st)) | |
445 | (sys-name (string-append "/sys/dev/" | |
446 | (case type | |
447 | ((block-special) "block") | |
448 | ((char-special) "char") | |
449 | (else (symbol->string type))) | |
450 | "/" (number->string major) ":" | |
451 | (number->string minor))) | |
452 | (directory (canonicalize-path (readlink* sys-name)))) | |
453 | (let loop ((components (string-tokenize directory %not-slash)) | |
454 | (aliases '())) | |
455 | (match components | |
456 | (("sys" "devices" _) | |
457 | (reverse aliases)) | |
458 | ((head ... _) | |
459 | (let ((uevent (string-append (string-join components "/" 'prefix) | |
460 | "/uevent"))) | |
461 | (if (file-exists? uevent) | |
462 | (let ((props (call-with-input-file uevent read-uevent))) | |
463 | (match (assq-ref props 'MODALIAS) | |
464 | (#f (loop head aliases)) | |
465 | (alias (loop head (cons alias aliases))))) | |
466 | (loop head aliases)))))))) | |
467 | ||
468 | (define (read-module-aliases port) | |
469 | "Read from PORT data in the Linux 'modules.alias' file format. Return a | |
470 | list of alias/module pairs where each alias is a glob pattern as like the | |
471 | result of: | |
472 | ||
71e08fde | 473 | (string->compiled-sglob \"scsi:t-0x01*\") |
8661ad27 LC |
474 | |
475 | and each module is a module name like \"snd_hda_intel\"." | |
476 | (define (comment? str) | |
477 | (string-prefix? "#" str)) | |
478 | ||
479 | (define (tokenize str) | |
480 | ;; Lines have the form "alias ALIAS MODULE", where ALIAS can contain | |
481 | ;; whitespace. This is why we don't use 'string-tokenize'. | |
482 | (let* ((str (string-trim-both str)) | |
483 | (left (string-index str #\space)) | |
484 | (right (string-rindex str #\space))) | |
485 | (list (string-take str left) | |
486 | (string-trim-both (substring str left right)) | |
487 | (string-trim-both (string-drop str right))))) | |
488 | ||
489 | (let loop ((aliases '())) | |
490 | (match (read-line port) | |
491 | ((? eof-object?) | |
492 | (reverse aliases)) | |
493 | ((? comment?) | |
494 | (loop aliases)) | |
495 | (line | |
496 | (match (tokenize line) | |
497 | (("alias" alias module) | |
71e08fde | 498 | (loop (alist-cons (string->compiled-sglob alias) module |
8661ad27 LC |
499 | aliases))) |
500 | (() ;empty line | |
501 | (loop aliases))))))) | |
502 | ||
a57df67b LC |
503 | (define (current-kernel-directory) |
504 | "Return the directory of the currently running Linux kernel." | |
8661ad27 LC |
505 | (string-append (or (getenv "LINUX_MODULE_DIRECTORY") |
506 | "/run/booted-system/kernel/lib/modules") | |
a57df67b LC |
507 | "/" (utsname:release (uname)))) |
508 | ||
509 | (define (current-alias-file) | |
510 | "Return the absolute file name of the default 'modules.alias' file." | |
511 | (string-append (current-kernel-directory) "/modules.alias")) | |
8661ad27 LC |
512 | |
513 | (define* (known-module-aliases #:optional (alias-file (current-alias-file))) | |
514 | "Return the list of alias/module pairs read from ALIAS-FILE. Each alias is | |
515 | actually a pattern." | |
516 | (call-with-input-file alias-file read-module-aliases)) | |
517 | ||
518 | (define* (matching-modules alias | |
519 | #:optional (known-aliases (known-module-aliases))) | |
520 | "Return the list of modules that match ALIAS according to KNOWN-ALIASES. | |
521 | ALIAS is a string like \"scsi:t-0x00\" as returned by | |
522 | 'device-module-aliases'." | |
523 | (filter-map (match-lambda | |
524 | ((pattern . module) | |
525 | (and (glob-match? pattern alias) | |
526 | module))) | |
527 | known-aliases)) | |
528 | ||
4cd386af LC |
529 | (define* (missing-modules device modules-provided) |
530 | "Assuming MODULES-PROVIDED lists kernel modules that are already | |
531 | provided--e.g., in the initrd, return the list of missing kernel modules that | |
532 | are required to access DEVICE." | |
533 | (define aliases | |
534 | ;; Attempt to load 'modules.alias' from the current kernel, assuming we're | |
535 | ;; on Guix System, and assuming that corresponds to the kernel we'll be | |
536 | ;; installing. | |
537 | (known-module-aliases)) | |
538 | ||
539 | (if aliases | |
540 | (let* ((modules (delete-duplicates | |
541 | (append-map (cut matching-modules <> aliases) | |
542 | (device-module-aliases device)))) | |
543 | ||
544 | ;; Module names (not file names) are supposed to use underscores | |
545 | ;; instead of hyphens. MODULES is a list of module names, whereas | |
546 | ;; LINUX-MODULES is file names without '.ko', so normalize them. | |
547 | (provided (map file-name->module-name modules-provided))) | |
548 | (remove (cut member <> provided) modules)) | |
549 | '())) | |
550 | ||
c85ccf60 LC |
551 | \f |
552 | ;;; | |
553 | ;;; Module databases. | |
554 | ;;; | |
555 | ||
755f365b MO |
556 | (define* (module-name->file-name/guess directory name |
557 | #:key compression) | |
c85ccf60 LC |
558 | "Guess the file name corresponding to NAME, a module name. That doesn't |
559 | always work because sometimes underscores in NAME map to hyphens (e.g., | |
755f365b MO |
560 | \"input-leds.ko\"), sometimes not (e.g., \"mac_hid.ko\"). If the module is |
561 | compressed then COMPRESSED can be set to 'xz or 'gzip, depending on the | |
562 | compression type." | |
563 | (string-append directory "/" (ensure-dot-ko name compression))) | |
c85ccf60 LC |
564 | |
565 | (define (module-name-lookup directory) | |
566 | "Return a one argument procedure that takes a module name (e.g., | |
567 | \"input_leds\") and returns its absolute file name (e.g., | |
568 | \"/.../input-leds.ko\")." | |
755f365b MO |
569 | (define (guess-file-name name) |
570 | (let ((names (list | |
571 | (module-name->file-name/guess directory name) | |
572 | (module-name->file-name/guess directory name | |
573 | #:compression 'xz) | |
574 | (module-name->file-name/guess directory name | |
575 | #:compression 'gzip)))) | |
576 | (or (find file-exists? names) | |
577 | (first names)))) | |
578 | ||
c85ccf60 LC |
579 | (catch 'system-error |
580 | (lambda () | |
581 | (define mapping | |
582 | (call-with-input-file (string-append directory "/modules.name") | |
583 | read)) | |
584 | ||
585 | (lambda (name) | |
586 | (or (assoc-ref mapping name) | |
755f365b | 587 | (guess-file-name name)))) |
c85ccf60 LC |
588 | (lambda args |
589 | (if (= ENOENT (system-error-errno args)) | |
755f365b | 590 | (cut guess-file-name <>) |
c85ccf60 LC |
591 | (apply throw args))))) |
592 | ||
593 | (define (write-module-name-database directory) | |
594 | "Write a database that maps \"module names\" as they appear in the relevant | |
755f365b | 595 | ELF section of '.ko[.gz|.xz]' files, to actual file names. This format is |
c85ccf60 LC |
596 | Guix-specific. It aims to deal with inconsistent naming, in particular |
597 | hyphens vs. underscores." | |
598 | (define mapping | |
599 | (map (lambda (file) | |
600 | (match (module-formal-name file) | |
755f365b | 601 | (#f (cons (strip-extension (basename file)) file)) |
c85ccf60 | 602 | (name (cons name file)))) |
755f365b | 603 | (find-files directory module-regex))) |
c85ccf60 LC |
604 | |
605 | (call-with-output-file (string-append directory "/modules.name") | |
606 | (lambda (port) | |
607 | (display ";; Module name to file name mapping. | |
608 | ;; | |
609 | ;; This format is Guix-specific; it is not supported by upstream Linux tools. | |
610 | \n" | |
611 | port) | |
612 | (pretty-print mapping port)))) | |
613 | ||
4f8b9d1a | 614 | (define (write-module-alias-database directory) |
755f365b | 615 | "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding |
4f8b9d1a DM |
616 | 'modules.alias' file." |
617 | (define aliases | |
618 | (map (lambda (file) | |
619 | (cons (file-name->module-name file) (module-aliases file))) | |
755f365b | 620 | (find-files directory module-regex))) |
4f8b9d1a DM |
621 | |
622 | (call-with-output-file (string-append directory "/modules.alias") | |
623 | (lambda (port) | |
624 | (display "# Aliases extracted from modules themselves.\n" port) | |
625 | (for-each (match-lambda | |
626 | ((module . aliases) | |
627 | (for-each (lambda (alias) | |
628 | (format port "alias ~a ~a\n" alias module)) | |
629 | aliases))) | |
630 | aliases)))) | |
631 | ||
2a693b69 LC |
632 | (define (aliases->device-tuple aliases) |
633 | "Traverse ALIASES, a list of module aliases, and search for | |
634 | \"char-major-M-N\", \"block-major-M-N\", or \"devname:\" aliases. When they | |
635 | are found, return a tuple (DEVNAME TYPE MAJOR MINOR), otherwise return #f." | |
636 | (define (char/block-major? alias) | |
637 | (or (string-prefix? "char-major-" alias) | |
638 | (string-prefix? "block-major-" alias))) | |
639 | ||
640 | (define (char/block-major->tuple alias) | |
641 | (match (string-tokenize alias %not-dash) | |
642 | ((type "major" (= string->number major) (= string->number minor)) | |
643 | (list (match type | |
644 | ("char" "c") | |
645 | ("block" "b")) | |
646 | major minor)))) | |
647 | ||
648 | (let* ((devname (any (lambda (alias) | |
649 | (and (string-prefix? "devname:" alias) | |
650 | (string-drop alias 8))) | |
651 | aliases)) | |
652 | (major/minor (match (find char/block-major? aliases) | |
653 | (#f #f) | |
654 | (str (char/block-major->tuple str))))) | |
655 | (and devname major/minor | |
656 | (cons devname major/minor)))) | |
657 | ||
658 | (define %not-dash | |
659 | (char-set-complement (char-set #\-))) | |
660 | ||
661 | (define (write-module-device-database directory) | |
755f365b | 662 | "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding |
2a693b69 LC |
663 | 'modules.devname' file. This file contains information about modules that can |
664 | be loaded on-demand, such as file system modules." | |
665 | (define aliases | |
666 | (filter-map (lambda (file) | |
667 | (match (aliases->device-tuple (module-aliases file)) | |
668 | (#f #f) | |
669 | (tuple (cons (file-name->module-name file) tuple)))) | |
755f365b | 670 | (find-files directory module-regex))) |
2a693b69 LC |
671 | |
672 | (call-with-output-file (string-append directory "/modules.devname") | |
673 | (lambda (port) | |
674 | (display "# Device nodes to trigger on-demand module loading.\n" port) | |
675 | (for-each (match-lambda | |
676 | ((module devname type major minor) | |
677 | (format port "~a ~a ~a~a:~a~%" | |
678 | module devname type major minor))) | |
679 | aliases)))) | |
680 | ||
5c79f238 DM |
681 | (define (depmod version directory) |
682 | "Given an (existing) DIRECTORY, invoke depmod on it for | |
683 | kernel version VERSION." | |
684 | (let ((destination-directory (string-append directory "/lib/modules/" | |
685 | version)) | |
686 | ;; Note: "System.map" is an input file. | |
687 | (maps-file (string-append directory "/System.map")) | |
688 | ;; Note: "Module.symvers" is an input file. | |
689 | (symvers-file (string-append directory "/Module.symvers"))) | |
690 | ;; These files will be regenerated by depmod below. | |
691 | (for-each (lambda (basename) | |
692 | (when (and (string-prefix? "modules." basename) | |
693 | ;; Note: "modules.builtin" is an input file. | |
694 | (not (string=? "modules.builtin" basename)) | |
695 | ;; Note: "modules.order" is an input file. | |
696 | (not (string=? "modules.order" basename))) | |
697 | (delete-file (string-append destination-directory "/" | |
698 | basename)))) | |
699 | (scandir destination-directory)) | |
700 | (invoke "depmod" | |
701 | "-e" ; Report symbols that aren't supplied | |
702 | ;"-w" ; Warn on duplicates | |
703 | "-b" directory | |
704 | "-F" maps-file | |
705 | ;"-E" symvers-file ; using both "-E" and "-F" is not possible. | |
706 | version))) | |
707 | ||
708 | (define (make-linux-module-directory inputs version output) | |
709 | "Create a new directory OUTPUT and ensure that the directory | |
710 | OUTPUT/lib/modules/VERSION can be used as a source of Linux | |
711 | kernel modules for the first kmod in PATH now to eventually | |
712 | load. Take modules to put into OUTPUT from INPUTS. | |
713 | ||
714 | Right now that means it creates @code{modules.*.bin} which | |
715 | @command{modprobe} will use to find loadable modules." | |
716 | (union-build output inputs #:create-all-directories? #t) | |
717 | (depmod version output)) | |
718 | ||
fcaa5f44 | 719 | ;;; linux-modules.scm ends here |