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