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> |
fcaa5f44 LC |
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 (gnu build linux-modules) | |
21 | #:use-module (guix elf) | |
8661ad27 | 22 | #:use-module (guix glob) |
a5e13c3b | 23 | #:use-module (guix build syscalls) |
fcd068e9 | 24 | #:use-module ((guix build utils) #:select (find-files)) |
fcaa5f44 LC |
25 | #:use-module (rnrs io ports) |
26 | #:use-module (rnrs bytevectors) | |
27 | #:use-module (srfi srfi-1) | |
f347fb79 | 28 | #:use-module (srfi srfi-11) |
fcaa5f44 LC |
29 | #:use-module (srfi srfi-26) |
30 | #:use-module (ice-9 vlist) | |
31 | #:use-module (ice-9 match) | |
8661ad27 | 32 | #:use-module (ice-9 rdelim) |
fcaa5f44 LC |
33 | #:export (dot-ko |
34 | ensure-dot-ko | |
8b2219d8 | 35 | module-aliases |
fcaa5f44 | 36 | module-dependencies |
1a5f4662 | 37 | module-soft-dependencies |
411959be | 38 | normalize-module-name |
d2a1cf45 | 39 | file-name->module-name |
fcd068e9 | 40 | find-module-file |
fcaa5f44 LC |
41 | recursive-module-dependencies |
42 | modules-loaded | |
43 | module-loaded? | |
44 | load-linux-module* | |
45 | ||
8661ad27 LC |
46 | current-module-debugging-port |
47 | ||
48 | device-module-aliases | |
49 | known-module-aliases | |
4cd386af LC |
50 | matching-modules |
51 | missing-modules)) | |
fcaa5f44 LC |
52 | |
53 | ;;; Commentary: | |
54 | ;;; | |
55 | ;;; Tools to deal with Linux kernel modules. | |
56 | ;;; | |
57 | ;;; Code: | |
58 | ||
59 | (define current-module-debugging-port | |
60 | (make-parameter (%make-void-port "w"))) | |
61 | ||
62 | (define (section-contents elf section) | |
63 | "Return the contents of SECTION in ELF as a bytevector." | |
f43d2dcd LC |
64 | (let ((contents (make-bytevector (elf-section-size section)))) |
65 | (bytevector-copy! (elf-bytes elf) (elf-section-offset section) | |
fcaa5f44 | 66 | contents 0 |
f43d2dcd | 67 | (elf-section-size section)) |
fcaa5f44 LC |
68 | contents)) |
69 | ||
70 | (define %not-nul | |
71 | (char-set-complement (char-set #\nul))) | |
72 | ||
73 | (define (nul-separated-string->list str) | |
74 | "Split STR at occurrences of the NUL character and return the resulting | |
75 | string list." | |
76 | (string-tokenize str %not-nul)) | |
77 | ||
78 | (define (key=value->pair str) | |
79 | "Assuming STR has the form \"KEY=VALUE\", return a pair like (KEY | |
80 | . \"VALUE\")." | |
81 | (let ((= (string-index str #\=))) | |
82 | (cons (string->symbol (string-take str =)) | |
83 | (string-drop str (+ 1 =))))) | |
84 | ||
85 | (define (modinfo-section-contents file) | |
86 | "Return the contents of the '.modinfo' section of FILE as a list of | |
87 | key/value pairs.." | |
88 | (let* ((bv (call-with-input-file file get-bytevector-all)) | |
89 | (elf (parse-elf bv)) | |
f43d2dcd LC |
90 | (section (elf-section-by-name elf ".modinfo")) |
91 | (modinfo (section-contents elf section))) | |
fcaa5f44 LC |
92 | (map key=value->pair |
93 | (nul-separated-string->list (utf8->string modinfo))))) | |
94 | ||
95 | (define %not-comma | |
96 | (char-set-complement (char-set #\,))) | |
97 | ||
98 | (define (module-dependencies file) | |
99 | "Return the list of modules that FILE depends on. The returned list | |
100 | contains module names, not actual file names." | |
101 | (let ((info (modinfo-section-contents file))) | |
102 | (match (assq 'depends info) | |
103 | (('depends . what) | |
104 | (string-tokenize what %not-comma))))) | |
105 | ||
1a5f4662 DM |
106 | (define not-softdep-whitespace |
107 | (char-set-complement (char-set #\space #\tab))) | |
108 | ||
109 | (define (module-soft-dependencies file) | |
f347fb79 DM |
110 | "Return the list of modules that can be preloaded, and then the list of |
111 | modules that can be postloaded, of the soft dependencies of module FILE." | |
1a5f4662 DM |
112 | ;; TEXT: "pre: baz blubb foo post: bax bar" |
113 | (define (parse-softdep text) | |
114 | (let loop ((value '()) | |
115 | (tokens (string-tokenize text not-softdep-whitespace)) | |
116 | (section #f)) | |
117 | (match tokens | |
118 | ((token rest ...) | |
119 | (if (string=? (string-take-right token 1) ":") ; section | |
519be98c | 120 | (loop value rest (string-trim-both (string-drop-right token 1))) |
1a5f4662 DM |
121 | (loop (cons (cons section token) value) rest section))) |
122 | (() | |
123 | value)))) | |
124 | ||
125 | ;; Note: Multiple 'softdep sections are allowed. | |
f347fb79 DM |
126 | (let* ((info (modinfo-section-contents file)) |
127 | (entries (concatenate | |
128 | (filter-map (match-lambda | |
129 | (('softdep . value) | |
130 | (parse-softdep value)) | |
131 | (_ #f)) | |
132 | (modinfo-section-contents file))))) | |
133 | (let-values (((pres posts) | |
134 | (partition (match-lambda | |
135 | (("pre" . _) #t) | |
136 | (("post" . _) #f)) | |
137 | entries))) | |
138 | (values (map (match-lambda | |
139 | ((_ . value) value)) | |
140 | pres) | |
141 | (map (match-lambda | |
142 | ((_ . value) value)) | |
143 | posts))))) | |
1a5f4662 | 144 | |
8b2219d8 DM |
145 | (define (module-aliases file) |
146 | "Return the list of aliases of module FILE." | |
147 | (let ((info (modinfo-section-contents file))) | |
148 | (filter-map (match-lambda | |
149 | (('alias . value) | |
150 | value) | |
151 | (_ #f)) | |
152 | (modinfo-section-contents file)))) | |
153 | ||
fcaa5f44 LC |
154 | (define dot-ko |
155 | (cut string-append <> ".ko")) | |
156 | ||
157 | (define (ensure-dot-ko name) | |
158 | "Return NAME with a '.ko' prefix appended, unless it already has it." | |
159 | (if (string-suffix? ".ko" name) | |
160 | name | |
161 | (dot-ko name))) | |
162 | ||
5c7dd5ac LC |
163 | (define (normalize-module-name module) |
164 | "Return the \"canonical\" name for MODULE, replacing hyphens with | |
165 | underscores." | |
166 | ;; See 'modname_normalize' in libkmod. | |
167 | (string-map (lambda (chr) | |
168 | (case chr | |
169 | ((#\-) #\_) | |
170 | (else chr))) | |
171 | module)) | |
172 | ||
7ba903b6 | 173 | (define (file-name->module-name file) |
5c7dd5ac LC |
174 | "Return the module name corresponding to FILE, stripping the trailing '.ko' |
175 | and normalizing it." | |
176 | (normalize-module-name (basename file ".ko"))) | |
7ba903b6 | 177 | |
fcd068e9 LC |
178 | (define (find-module-file directory module) |
179 | "Lookup module NAME under DIRECTORY, and return its absolute file name. | |
180 | NAME can be a file name with or without '.ko', or it can be a module name. | |
4db7a9dc | 181 | Raise an error if it could not be found. |
fcd068e9 LC |
182 | |
183 | Module names can differ from file names in interesting ways; for instance, | |
184 | module names usually (always?) use underscores as the inter-word separator, | |
185 | whereas file names often, but not always, use hyphens. Examples: | |
186 | \"usb-storage.ko\", \"serpent_generic.ko\"." | |
187 | (define names | |
188 | ;; List of possible file names. XXX: It would of course be cleaner to | |
189 | ;; have a database that maps module names to file names and vice versa, | |
190 | ;; but everyone seems to be doing hacks like this one. Oh well! | |
191 | (map ensure-dot-ko | |
192 | (delete-duplicates | |
193 | (list module | |
194 | (normalize-module-name module) | |
195 | (string-map (lambda (chr) ;converse of 'normalize-module-name' | |
196 | (case chr | |
197 | ((#\_) #\-) | |
198 | (else chr))) | |
199 | module))))) | |
200 | ||
201 | (match (find-files directory | |
202 | (lambda (file stat) | |
203 | (member (basename file) names))) | |
204 | ((file) | |
205 | file) | |
206 | (() | |
4db7a9dc | 207 | (error "kernel module not found" module directory)) |
fcd068e9 LC |
208 | ((_ ...) |
209 | (error "several modules by that name" module directory)))) | |
210 | ||
fcaa5f44 LC |
211 | (define* (recursive-module-dependencies files |
212 | #:key (lookup-module dot-ko)) | |
213 | "Return the topologically-sorted list of file names of the modules depended | |
214 | on by FILES, recursively. File names of modules are determined by applying | |
215 | LOOKUP-MODULE to the module name." | |
216 | (let loop ((files files) | |
217 | (result '()) | |
218 | (visited vlist-null)) | |
219 | (match files | |
220 | (() | |
221 | (delete-duplicates (reverse result))) | |
222 | ((head . tail) | |
223 | (let* ((visited? (vhash-assoc head visited)) | |
224 | (deps (if visited? | |
225 | '() | |
226 | (map lookup-module (module-dependencies head)))) | |
227 | (visited (if visited? | |
228 | visited | |
229 | (vhash-cons head #t visited)))) | |
230 | (loop (append deps tail) | |
231 | (append result deps) visited)))))) | |
232 | ||
233 | (define %not-newline | |
234 | (char-set-complement (char-set #\newline))) | |
235 | ||
236 | (define (modules-loaded) | |
237 | "Return the list of names of currently loaded Linux modules." | |
238 | (let* ((contents (call-with-input-file "/proc/modules" | |
239 | get-string-all)) | |
240 | (lines (string-tokenize contents %not-newline))) | |
241 | (match (map string-tokenize lines) | |
242 | (((modules . _) ...) | |
243 | modules)))) | |
244 | ||
7ba903b6 LC |
245 | (define (module-black-list) |
246 | "Return the black list of modules that must not be loaded. This black list | |
247 | is specified using 'modprobe.blacklist=MODULE1,MODULE2,...' on the kernel | |
5c7dd5ac LC |
248 | command line; it is honored by libkmod for users that pass |
249 | 'KMOD_PROBE_APPLY_BLACKLIST', which includes 'modprobe --use-blacklist' and | |
250 | udev." | |
7ba903b6 LC |
251 | (define parameter |
252 | "modprobe.blacklist=") | |
253 | ||
254 | (let ((command (call-with-input-file "/proc/cmdline" | |
255 | get-string-all))) | |
256 | (append-map (lambda (arg) | |
257 | (if (string-prefix? parameter arg) | |
258 | (string-tokenize (string-drop arg (string-length parameter)) | |
259 | %not-comma) | |
260 | '())) | |
261 | (string-tokenize command)))) | |
262 | ||
fcaa5f44 LC |
263 | (define (module-loaded? module) |
264 | "Return #t if MODULE is already loaded. MODULE must be a Linux module name, | |
265 | not a file name." | |
266 | (member module (modules-loaded))) | |
267 | ||
268 | (define* (load-linux-module* file | |
269 | #:key | |
270 | (recursive? #t) | |
7ba903b6 LC |
271 | (lookup-module dot-ko) |
272 | (black-list (module-black-list))) | |
273 | "Load Linux module from FILE, the name of a '.ko' file; return true on | |
274 | success, false otherwise. When RECURSIVE? is true, load its dependencies | |
275 | first (à la 'modprobe'.) The actual files containing modules depended on are | |
276 | obtained by calling LOOKUP-MODULE with the module name. Modules whose name | |
277 | appears in BLACK-LIST are not loaded." | |
7ba903b6 LC |
278 | (define (black-listed? module) |
279 | (let ((result (member module black-list))) | |
280 | (when result | |
281 | (format (current-module-debugging-port) | |
282 | "not loading module '~a' because it's black-listed~%" | |
283 | module)) | |
284 | result)) | |
285 | ||
286 | (define (load-dependencies file) | |
287 | (let ((dependencies (module-dependencies file))) | |
675e81a0 LC |
288 | (every (cut load-linux-module* <> |
289 | #:lookup-module lookup-module | |
290 | #:black-list black-list) | |
7ba903b6 LC |
291 | (map lookup-module dependencies)))) |
292 | ||
293 | (and (not (black-listed? (file-name->module-name file))) | |
294 | (or (not recursive?) | |
295 | (load-dependencies file)) | |
3c14e7e6 | 296 | (let ((fd #f)) |
7ba903b6 LC |
297 | (format (current-module-debugging-port) |
298 | "loading Linux module from '~a'...~%" file) | |
299 | ||
300 | (catch 'system-error | |
301 | (lambda () | |
3c14e7e6 LC |
302 | (set! fd (open-fdes file O_RDONLY)) |
303 | (load-linux-module/fd fd) | |
304 | (close-fdes fd) | |
305 | #t) | |
7ba903b6 LC |
306 | (lambda args |
307 | ;; If this module was already loaded and we're in modprobe style, ignore | |
308 | ;; the error. | |
3c14e7e6 | 309 | (when fd (close-fdes fd)) |
7ba903b6 LC |
310 | (or (and recursive? (= EEXIST (system-error-errno args))) |
311 | (apply throw args))))))) | |
fcaa5f44 | 312 | |
8661ad27 LC |
313 | \f |
314 | ;;; | |
315 | ;;; Device modules. | |
316 | ;;; | |
317 | ||
318 | ;; Copied from (guix utils). FIXME: Factorize. | |
319 | (define (readlink* file) | |
320 | "Call 'readlink' until the result is not a symlink." | |
321 | (define %max-symlink-depth 50) | |
322 | ||
323 | (let loop ((file file) | |
324 | (depth 0)) | |
325 | (define (absolute target) | |
326 | (if (absolute-file-name? target) | |
327 | target | |
328 | (string-append (dirname file) "/" target))) | |
329 | ||
330 | (if (>= depth %max-symlink-depth) | |
331 | file | |
332 | (call-with-values | |
333 | (lambda () | |
334 | (catch 'system-error | |
335 | (lambda () | |
336 | (values #t (readlink file))) | |
337 | (lambda args | |
338 | (let ((errno (system-error-errno args))) | |
339 | (if (or (= errno EINVAL)) | |
340 | (values #f file) | |
341 | (apply throw args)))))) | |
342 | (lambda (success? target) | |
343 | (if success? | |
344 | (loop (absolute target) (+ depth 1)) | |
345 | file)))))) | |
346 | ||
347 | ;; See 'major' and 'minor' in <sys/sysmacros.h>. | |
348 | ||
349 | (define (stat->device-major st) | |
350 | (ash (logand #xfff00 (stat:rdev st)) -8)) | |
351 | ||
352 | (define (stat->device-minor st) | |
353 | (logand #xff (stat:rdev st))) | |
354 | ||
355 | (define %not-slash | |
356 | (char-set-complement (char-set #\/))) | |
357 | ||
358 | (define (read-uevent port) | |
359 | "Read a /sys 'uevent' file from PORT and return an alist where each car is a | |
360 | key such as 'MAJOR or 'DEVTYPE and each cdr is the corresponding value." | |
361 | (let loop ((result '())) | |
362 | (match (read-line port) | |
363 | ((? eof-object?) | |
364 | (reverse result)) | |
365 | (line | |
366 | (loop (cons (key=value->pair line) result)))))) | |
367 | ||
368 | (define (device-module-aliases device) | |
369 | "Return the list of module aliases required by DEVICE, a /dev file name, as | |
370 | in this example: | |
371 | ||
372 | (device-module-aliases \"/dev/sda\") | |
373 | => (\"scsi:t-0x00\" \"pci:v00008086d00009D03sv0000103Csd000080FAbc01sc06i01\") | |
374 | ||
375 | The modules corresponding to these aliases can then be found using | |
376 | 'matching-modules'." | |
377 | ;; The approach is adapted from | |
378 | ;; <https://unix.stackexchange.com/questions/97676/how-to-find-the-driver-module-associated-with-a-device-on-linux>. | |
379 | (let* ((st (stat device)) | |
380 | (type (stat:type st)) | |
381 | (major (stat->device-major st)) | |
382 | (minor (stat->device-minor st)) | |
383 | (sys-name (string-append "/sys/dev/" | |
384 | (case type | |
385 | ((block-special) "block") | |
386 | ((char-special) "char") | |
387 | (else (symbol->string type))) | |
388 | "/" (number->string major) ":" | |
389 | (number->string minor))) | |
390 | (directory (canonicalize-path (readlink* sys-name)))) | |
391 | (let loop ((components (string-tokenize directory %not-slash)) | |
392 | (aliases '())) | |
393 | (match components | |
394 | (("sys" "devices" _) | |
395 | (reverse aliases)) | |
396 | ((head ... _) | |
397 | (let ((uevent (string-append (string-join components "/" 'prefix) | |
398 | "/uevent"))) | |
399 | (if (file-exists? uevent) | |
400 | (let ((props (call-with-input-file uevent read-uevent))) | |
401 | (match (assq-ref props 'MODALIAS) | |
402 | (#f (loop head aliases)) | |
403 | (alias (loop head (cons alias aliases))))) | |
404 | (loop head aliases)))))))) | |
405 | ||
406 | (define (read-module-aliases port) | |
407 | "Read from PORT data in the Linux 'modules.alias' file format. Return a | |
408 | list of alias/module pairs where each alias is a glob pattern as like the | |
409 | result of: | |
410 | ||
71e08fde | 411 | (string->compiled-sglob \"scsi:t-0x01*\") |
8661ad27 LC |
412 | |
413 | and each module is a module name like \"snd_hda_intel\"." | |
414 | (define (comment? str) | |
415 | (string-prefix? "#" str)) | |
416 | ||
417 | (define (tokenize str) | |
418 | ;; Lines have the form "alias ALIAS MODULE", where ALIAS can contain | |
419 | ;; whitespace. This is why we don't use 'string-tokenize'. | |
420 | (let* ((str (string-trim-both str)) | |
421 | (left (string-index str #\space)) | |
422 | (right (string-rindex str #\space))) | |
423 | (list (string-take str left) | |
424 | (string-trim-both (substring str left right)) | |
425 | (string-trim-both (string-drop str right))))) | |
426 | ||
427 | (let loop ((aliases '())) | |
428 | (match (read-line port) | |
429 | ((? eof-object?) | |
430 | (reverse aliases)) | |
431 | ((? comment?) | |
432 | (loop aliases)) | |
433 | (line | |
434 | (match (tokenize line) | |
435 | (("alias" alias module) | |
71e08fde | 436 | (loop (alist-cons (string->compiled-sglob alias) module |
8661ad27 LC |
437 | aliases))) |
438 | (() ;empty line | |
439 | (loop aliases))))))) | |
440 | ||
a57df67b LC |
441 | (define (current-kernel-directory) |
442 | "Return the directory of the currently running Linux kernel." | |
8661ad27 LC |
443 | (string-append (or (getenv "LINUX_MODULE_DIRECTORY") |
444 | "/run/booted-system/kernel/lib/modules") | |
a57df67b LC |
445 | "/" (utsname:release (uname)))) |
446 | ||
447 | (define (current-alias-file) | |
448 | "Return the absolute file name of the default 'modules.alias' file." | |
449 | (string-append (current-kernel-directory) "/modules.alias")) | |
8661ad27 LC |
450 | |
451 | (define* (known-module-aliases #:optional (alias-file (current-alias-file))) | |
452 | "Return the list of alias/module pairs read from ALIAS-FILE. Each alias is | |
453 | actually a pattern." | |
454 | (call-with-input-file alias-file read-module-aliases)) | |
455 | ||
456 | (define* (matching-modules alias | |
457 | #:optional (known-aliases (known-module-aliases))) | |
458 | "Return the list of modules that match ALIAS according to KNOWN-ALIASES. | |
459 | ALIAS is a string like \"scsi:t-0x00\" as returned by | |
460 | 'device-module-aliases'." | |
461 | (filter-map (match-lambda | |
462 | ((pattern . module) | |
463 | (and (glob-match? pattern alias) | |
464 | module))) | |
465 | known-aliases)) | |
466 | ||
4cd386af LC |
467 | (define* (missing-modules device modules-provided) |
468 | "Assuming MODULES-PROVIDED lists kernel modules that are already | |
469 | provided--e.g., in the initrd, return the list of missing kernel modules that | |
470 | are required to access DEVICE." | |
471 | (define aliases | |
472 | ;; Attempt to load 'modules.alias' from the current kernel, assuming we're | |
473 | ;; on Guix System, and assuming that corresponds to the kernel we'll be | |
474 | ;; installing. | |
475 | (known-module-aliases)) | |
476 | ||
477 | (if aliases | |
478 | (let* ((modules (delete-duplicates | |
479 | (append-map (cut matching-modules <> aliases) | |
480 | (device-module-aliases device)))) | |
481 | ||
482 | ;; Module names (not file names) are supposed to use underscores | |
483 | ;; instead of hyphens. MODULES is a list of module names, whereas | |
484 | ;; LINUX-MODULES is file names without '.ko', so normalize them. | |
485 | (provided (map file-name->module-name modules-provided))) | |
486 | (remove (cut member <> provided) modules)) | |
487 | '())) | |
488 | ||
fcaa5f44 | 489 | ;;; linux-modules.scm ends here |