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 | 356 | (lambda args |
3c14e7e6 | 357 | (when fd (close-fdes fd)) |
13f13554 TGRG |
358 | (let ((errno (system-error-errno args))) |
359 | (or (and recursive? ; we're operating in ‘modprobe’ style | |
360 | (member errno | |
361 | (list EEXIST ; already loaded | |
362 | EINVAL))) ; unsupported by hardware | |
363 | (apply throw args)))))))) | |
fcaa5f44 | 364 | |
e1a9a7f2 LC |
365 | (define (load-linux-modules-from-directory modules directory) |
366 | "Load MODULES and their dependencies from DIRECTORY, a directory containing | |
367 | the '.ko' files. The '.ko' suffix is automatically added to MODULES if | |
368 | needed." | |
c85ccf60 LC |
369 | (define module-name->file-name |
370 | (module-name-lookup directory)) | |
e1a9a7f2 | 371 | |
c85ccf60 LC |
372 | (for-each (lambda (module) |
373 | (load-linux-module* (module-name->file-name module) | |
374 | #:lookup-module module-name->file-name)) | |
375 | modules)) | |
e1a9a7f2 | 376 | |
8661ad27 LC |
377 | \f |
378 | ;;; | |
379 | ;;; Device modules. | |
380 | ;;; | |
381 | ||
382 | ;; Copied from (guix utils). FIXME: Factorize. | |
383 | (define (readlink* file) | |
384 | "Call 'readlink' until the result is not a symlink." | |
385 | (define %max-symlink-depth 50) | |
386 | ||
387 | (let loop ((file file) | |
388 | (depth 0)) | |
389 | (define (absolute target) | |
390 | (if (absolute-file-name? target) | |
391 | target | |
392 | (string-append (dirname file) "/" target))) | |
393 | ||
394 | (if (>= depth %max-symlink-depth) | |
395 | file | |
396 | (call-with-values | |
397 | (lambda () | |
398 | (catch 'system-error | |
399 | (lambda () | |
400 | (values #t (readlink file))) | |
401 | (lambda args | |
402 | (let ((errno (system-error-errno args))) | |
403 | (if (or (= errno EINVAL)) | |
404 | (values #f file) | |
405 | (apply throw args)))))) | |
406 | (lambda (success? target) | |
407 | (if success? | |
408 | (loop (absolute target) (+ depth 1)) | |
409 | file)))))) | |
410 | ||
411 | ;; See 'major' and 'minor' in <sys/sysmacros.h>. | |
412 | ||
413 | (define (stat->device-major st) | |
414 | (ash (logand #xfff00 (stat:rdev st)) -8)) | |
415 | ||
416 | (define (stat->device-minor st) | |
417 | (logand #xff (stat:rdev st))) | |
418 | ||
419 | (define %not-slash | |
420 | (char-set-complement (char-set #\/))) | |
421 | ||
422 | (define (read-uevent port) | |
423 | "Read a /sys 'uevent' file from PORT and return an alist where each car is a | |
424 | key such as 'MAJOR or 'DEVTYPE and each cdr is the corresponding value." | |
425 | (let loop ((result '())) | |
426 | (match (read-line port) | |
427 | ((? eof-object?) | |
428 | (reverse result)) | |
429 | (line | |
430 | (loop (cons (key=value->pair line) result)))))) | |
431 | ||
432 | (define (device-module-aliases device) | |
433 | "Return the list of module aliases required by DEVICE, a /dev file name, as | |
434 | in this example: | |
435 | ||
436 | (device-module-aliases \"/dev/sda\") | |
437 | => (\"scsi:t-0x00\" \"pci:v00008086d00009D03sv0000103Csd000080FAbc01sc06i01\") | |
438 | ||
439 | The modules corresponding to these aliases can then be found using | |
440 | 'matching-modules'." | |
441 | ;; The approach is adapted from | |
442 | ;; <https://unix.stackexchange.com/questions/97676/how-to-find-the-driver-module-associated-with-a-device-on-linux>. | |
443 | (let* ((st (stat device)) | |
444 | (type (stat:type st)) | |
445 | (major (stat->device-major st)) | |
446 | (minor (stat->device-minor st)) | |
447 | (sys-name (string-append "/sys/dev/" | |
448 | (case type | |
449 | ((block-special) "block") | |
450 | ((char-special) "char") | |
451 | (else (symbol->string type))) | |
452 | "/" (number->string major) ":" | |
453 | (number->string minor))) | |
454 | (directory (canonicalize-path (readlink* sys-name)))) | |
455 | (let loop ((components (string-tokenize directory %not-slash)) | |
456 | (aliases '())) | |
457 | (match components | |
458 | (("sys" "devices" _) | |
459 | (reverse aliases)) | |
460 | ((head ... _) | |
461 | (let ((uevent (string-append (string-join components "/" 'prefix) | |
462 | "/uevent"))) | |
463 | (if (file-exists? uevent) | |
464 | (let ((props (call-with-input-file uevent read-uevent))) | |
465 | (match (assq-ref props 'MODALIAS) | |
466 | (#f (loop head aliases)) | |
467 | (alias (loop head (cons alias aliases))))) | |
468 | (loop head aliases)))))))) | |
469 | ||
470 | (define (read-module-aliases port) | |
471 | "Read from PORT data in the Linux 'modules.alias' file format. Return a | |
472 | list of alias/module pairs where each alias is a glob pattern as like the | |
473 | result of: | |
474 | ||
71e08fde | 475 | (string->compiled-sglob \"scsi:t-0x01*\") |
8661ad27 LC |
476 | |
477 | and each module is a module name like \"snd_hda_intel\"." | |
478 | (define (comment? str) | |
479 | (string-prefix? "#" str)) | |
480 | ||
481 | (define (tokenize str) | |
482 | ;; Lines have the form "alias ALIAS MODULE", where ALIAS can contain | |
483 | ;; whitespace. This is why we don't use 'string-tokenize'. | |
484 | (let* ((str (string-trim-both str)) | |
485 | (left (string-index str #\space)) | |
486 | (right (string-rindex str #\space))) | |
487 | (list (string-take str left) | |
488 | (string-trim-both (substring str left right)) | |
489 | (string-trim-both (string-drop str right))))) | |
490 | ||
491 | (let loop ((aliases '())) | |
492 | (match (read-line port) | |
493 | ((? eof-object?) | |
494 | (reverse aliases)) | |
495 | ((? comment?) | |
496 | (loop aliases)) | |
497 | (line | |
498 | (match (tokenize line) | |
499 | (("alias" alias module) | |
71e08fde | 500 | (loop (alist-cons (string->compiled-sglob alias) module |
8661ad27 LC |
501 | aliases))) |
502 | (() ;empty line | |
503 | (loop aliases))))))) | |
504 | ||
a57df67b LC |
505 | (define (current-kernel-directory) |
506 | "Return the directory of the currently running Linux kernel." | |
8661ad27 LC |
507 | (string-append (or (getenv "LINUX_MODULE_DIRECTORY") |
508 | "/run/booted-system/kernel/lib/modules") | |
a57df67b LC |
509 | "/" (utsname:release (uname)))) |
510 | ||
511 | (define (current-alias-file) | |
512 | "Return the absolute file name of the default 'modules.alias' file." | |
513 | (string-append (current-kernel-directory) "/modules.alias")) | |
8661ad27 LC |
514 | |
515 | (define* (known-module-aliases #:optional (alias-file (current-alias-file))) | |
516 | "Return the list of alias/module pairs read from ALIAS-FILE. Each alias is | |
517 | actually a pattern." | |
518 | (call-with-input-file alias-file read-module-aliases)) | |
519 | ||
520 | (define* (matching-modules alias | |
521 | #:optional (known-aliases (known-module-aliases))) | |
522 | "Return the list of modules that match ALIAS according to KNOWN-ALIASES. | |
523 | ALIAS is a string like \"scsi:t-0x00\" as returned by | |
524 | 'device-module-aliases'." | |
525 | (filter-map (match-lambda | |
526 | ((pattern . module) | |
527 | (and (glob-match? pattern alias) | |
528 | module))) | |
529 | known-aliases)) | |
530 | ||
4cd386af LC |
531 | (define* (missing-modules device modules-provided) |
532 | "Assuming MODULES-PROVIDED lists kernel modules that are already | |
533 | provided--e.g., in the initrd, return the list of missing kernel modules that | |
534 | are required to access DEVICE." | |
535 | (define aliases | |
536 | ;; Attempt to load 'modules.alias' from the current kernel, assuming we're | |
537 | ;; on Guix System, and assuming that corresponds to the kernel we'll be | |
538 | ;; installing. | |
539 | (known-module-aliases)) | |
540 | ||
541 | (if aliases | |
542 | (let* ((modules (delete-duplicates | |
543 | (append-map (cut matching-modules <> aliases) | |
544 | (device-module-aliases device)))) | |
545 | ||
546 | ;; Module names (not file names) are supposed to use underscores | |
547 | ;; instead of hyphens. MODULES is a list of module names, whereas | |
548 | ;; LINUX-MODULES is file names without '.ko', so normalize them. | |
549 | (provided (map file-name->module-name modules-provided))) | |
550 | (remove (cut member <> provided) modules)) | |
551 | '())) | |
552 | ||
c85ccf60 LC |
553 | \f |
554 | ;;; | |
555 | ;;; Module databases. | |
556 | ;;; | |
557 | ||
755f365b MO |
558 | (define* (module-name->file-name/guess directory name |
559 | #:key compression) | |
c85ccf60 LC |
560 | "Guess the file name corresponding to NAME, a module name. That doesn't |
561 | always work because sometimes underscores in NAME map to hyphens (e.g., | |
755f365b MO |
562 | \"input-leds.ko\"), sometimes not (e.g., \"mac_hid.ko\"). If the module is |
563 | compressed then COMPRESSED can be set to 'xz or 'gzip, depending on the | |
564 | compression type." | |
565 | (string-append directory "/" (ensure-dot-ko name compression))) | |
c85ccf60 LC |
566 | |
567 | (define (module-name-lookup directory) | |
568 | "Return a one argument procedure that takes a module name (e.g., | |
569 | \"input_leds\") and returns its absolute file name (e.g., | |
570 | \"/.../input-leds.ko\")." | |
755f365b MO |
571 | (define (guess-file-name name) |
572 | (let ((names (list | |
573 | (module-name->file-name/guess directory name) | |
574 | (module-name->file-name/guess directory name | |
575 | #:compression 'xz) | |
576 | (module-name->file-name/guess directory name | |
577 | #:compression 'gzip)))) | |
578 | (or (find file-exists? names) | |
579 | (first names)))) | |
580 | ||
c85ccf60 LC |
581 | (catch 'system-error |
582 | (lambda () | |
583 | (define mapping | |
584 | (call-with-input-file (string-append directory "/modules.name") | |
585 | read)) | |
586 | ||
587 | (lambda (name) | |
588 | (or (assoc-ref mapping name) | |
755f365b | 589 | (guess-file-name name)))) |
c85ccf60 LC |
590 | (lambda args |
591 | (if (= ENOENT (system-error-errno args)) | |
755f365b | 592 | (cut guess-file-name <>) |
c85ccf60 LC |
593 | (apply throw args))))) |
594 | ||
595 | (define (write-module-name-database directory) | |
596 | "Write a database that maps \"module names\" as they appear in the relevant | |
755f365b | 597 | ELF section of '.ko[.gz|.xz]' files, to actual file names. This format is |
c85ccf60 LC |
598 | Guix-specific. It aims to deal with inconsistent naming, in particular |
599 | hyphens vs. underscores." | |
600 | (define mapping | |
601 | (map (lambda (file) | |
602 | (match (module-formal-name file) | |
755f365b | 603 | (#f (cons (strip-extension (basename file)) file)) |
c85ccf60 | 604 | (name (cons name file)))) |
755f365b | 605 | (find-files directory module-regex))) |
c85ccf60 LC |
606 | |
607 | (call-with-output-file (string-append directory "/modules.name") | |
608 | (lambda (port) | |
609 | (display ";; Module name to file name mapping. | |
610 | ;; | |
611 | ;; This format is Guix-specific; it is not supported by upstream Linux tools. | |
612 | \n" | |
613 | port) | |
614 | (pretty-print mapping port)))) | |
615 | ||
4f8b9d1a | 616 | (define (write-module-alias-database directory) |
755f365b | 617 | "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding |
4f8b9d1a DM |
618 | 'modules.alias' file." |
619 | (define aliases | |
620 | (map (lambda (file) | |
621 | (cons (file-name->module-name file) (module-aliases file))) | |
755f365b | 622 | (find-files directory module-regex))) |
4f8b9d1a DM |
623 | |
624 | (call-with-output-file (string-append directory "/modules.alias") | |
625 | (lambda (port) | |
626 | (display "# Aliases extracted from modules themselves.\n" port) | |
627 | (for-each (match-lambda | |
628 | ((module . aliases) | |
629 | (for-each (lambda (alias) | |
630 | (format port "alias ~a ~a\n" alias module)) | |
631 | aliases))) | |
632 | aliases)))) | |
633 | ||
2a693b69 LC |
634 | (define (aliases->device-tuple aliases) |
635 | "Traverse ALIASES, a list of module aliases, and search for | |
636 | \"char-major-M-N\", \"block-major-M-N\", or \"devname:\" aliases. When they | |
637 | are found, return a tuple (DEVNAME TYPE MAJOR MINOR), otherwise return #f." | |
638 | (define (char/block-major? alias) | |
639 | (or (string-prefix? "char-major-" alias) | |
640 | (string-prefix? "block-major-" alias))) | |
641 | ||
642 | (define (char/block-major->tuple alias) | |
643 | (match (string-tokenize alias %not-dash) | |
644 | ((type "major" (= string->number major) (= string->number minor)) | |
645 | (list (match type | |
646 | ("char" "c") | |
647 | ("block" "b")) | |
648 | major minor)))) | |
649 | ||
650 | (let* ((devname (any (lambda (alias) | |
651 | (and (string-prefix? "devname:" alias) | |
652 | (string-drop alias 8))) | |
653 | aliases)) | |
654 | (major/minor (match (find char/block-major? aliases) | |
655 | (#f #f) | |
656 | (str (char/block-major->tuple str))))) | |
657 | (and devname major/minor | |
658 | (cons devname major/minor)))) | |
659 | ||
660 | (define %not-dash | |
661 | (char-set-complement (char-set #\-))) | |
662 | ||
663 | (define (write-module-device-database directory) | |
755f365b | 664 | "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding |
2a693b69 LC |
665 | 'modules.devname' file. This file contains information about modules that can |
666 | be loaded on-demand, such as file system modules." | |
667 | (define aliases | |
668 | (filter-map (lambda (file) | |
669 | (match (aliases->device-tuple (module-aliases file)) | |
670 | (#f #f) | |
671 | (tuple (cons (file-name->module-name file) tuple)))) | |
755f365b | 672 | (find-files directory module-regex))) |
2a693b69 LC |
673 | |
674 | (call-with-output-file (string-append directory "/modules.devname") | |
675 | (lambda (port) | |
676 | (display "# Device nodes to trigger on-demand module loading.\n" port) | |
677 | (for-each (match-lambda | |
678 | ((module devname type major minor) | |
679 | (format port "~a ~a ~a~a:~a~%" | |
680 | module devname type major minor))) | |
681 | aliases)))) | |
682 | ||
5c79f238 DM |
683 | (define (depmod version directory) |
684 | "Given an (existing) DIRECTORY, invoke depmod on it for | |
685 | kernel version VERSION." | |
686 | (let ((destination-directory (string-append directory "/lib/modules/" | |
687 | version)) | |
688 | ;; Note: "System.map" is an input file. | |
689 | (maps-file (string-append directory "/System.map")) | |
690 | ;; Note: "Module.symvers" is an input file. | |
691 | (symvers-file (string-append directory "/Module.symvers"))) | |
692 | ;; These files will be regenerated by depmod below. | |
693 | (for-each (lambda (basename) | |
694 | (when (and (string-prefix? "modules." basename) | |
695 | ;; Note: "modules.builtin" is an input file. | |
696 | (not (string=? "modules.builtin" basename)) | |
697 | ;; Note: "modules.order" is an input file. | |
698 | (not (string=? "modules.order" basename))) | |
699 | (delete-file (string-append destination-directory "/" | |
700 | basename)))) | |
701 | (scandir destination-directory)) | |
702 | (invoke "depmod" | |
703 | "-e" ; Report symbols that aren't supplied | |
704 | ;"-w" ; Warn on duplicates | |
705 | "-b" directory | |
706 | "-F" maps-file | |
707 | ;"-E" symvers-file ; using both "-E" and "-F" is not possible. | |
708 | version))) | |
709 | ||
710 | (define (make-linux-module-directory inputs version output) | |
711 | "Create a new directory OUTPUT and ensure that the directory | |
712 | OUTPUT/lib/modules/VERSION can be used as a source of Linux | |
713 | kernel modules for the first kmod in PATH now to eventually | |
714 | load. Take modules to put into OUTPUT from INPUTS. | |
715 | ||
716 | Right now that means it creates @code{modules.*.bin} which | |
717 | @command{modprobe} will use to find loadable modules." | |
718 | (union-build output inputs #:create-all-directories? #t) | |
719 | (depmod version output)) | |
720 | ||
fcaa5f44 | 721 | ;;; linux-modules.scm ends here |