| blob | c66ef97012a6cdb5f79a9dcdd54d62d1b0ffc5b7 |
1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
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/>.
20 (define-module (gnu build linux-modules)
21 #:use-module (guix elf)
22 #:use-module (guix glob)
23 #:use-module (guix build syscalls)
24 #:use-module ((guix build utils) #:select (find-files))
25 #:use-module (rnrs io ports)
26 #:use-module (rnrs bytevectors)
27 #:use-module (srfi srfi-1)
28 #:use-module (srfi srfi-11)
29 #:use-module (srfi srfi-26)
30 #:use-module (ice-9 vlist)
31 #:use-module (ice-9 match)
32 #:use-module (ice-9 rdelim)
33 #:export (dot-ko
34 ensure-dot-ko
35 module-aliases
36 module-dependencies
37 module-soft-dependencies
38 normalize-module-name
39 file-name->module-name
40 find-module-file
41 recursive-module-dependencies
42 modules-loaded
43 module-loaded?
44 load-linux-module*
46 current-module-debugging-port
48 device-module-aliases
49 known-module-aliases
50 matching-modules
51 missing-modules))
53 ;;; Commentary:
54 ;;;
55 ;;; Tools to deal with Linux kernel modules.
56 ;;;
57 ;;; Code:
59 (define current-module-debugging-port
60 (make-parameter (%make-void-port "w")))
62 (define (section-contents elf section)
63 "Return the contents of SECTION in ELF as a bytevector."
64 (let ((contents (make-bytevector (elf-section-size section))))
65 (bytevector-copy! (elf-bytes elf) (elf-section-offset section)
66 contents 0
67 (elf-section-size section))
68 contents))
70 (define %not-nul
71 (char-set-complement (char-set #\nul)))
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))
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 =)))))
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))
90 (section (elf-section-by-name elf ".modinfo"))
91 (modinfo (section-contents elf section)))
92 (map key=value->pair
93 (nul-separated-string->list (utf8->string modinfo)))))
95 (define %not-comma
96 (char-set-complement (char-set #\,)))
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)))))
106 (define not-softdep-whitespace
107 (char-set-complement (char-set #\space #\tab)))
109 (define (module-soft-dependencies file)
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."
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
120 (loop value rest (string-trim-both (string-drop-right token 1)))
121 (loop (cons (cons section token) value) rest section)))
122 (()
123 value))))
125 ;; Note: Multiple 'softdep sections are allowed.
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)))))
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))))
154 (define dot-ko
155 (cut string-append <> ".ko"))
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)))
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))
173 (define (file-name->module-name file)
174 "Return the module name corresponding to FILE, stripping the trailing '.ko'
175 and normalizing it."
176 (normalize-module-name (basename file ".ko")))
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.
181 Raise an error if it could not be found.
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)))))
201 (match (find-files directory
202 (lambda (file stat)
203 (member (basename file) names)))
204 ((file)
205 file)
206 (()
207 (error "kernel module not found" module directory))
208 ((_ ...)
209 (error "several modules by that name" module directory))))
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))))))
233 (define %not-newline
234 (char-set-complement (char-set #\newline)))
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))))
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
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."
251 (define parameter
252 "modprobe.blacklist=")
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))))
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)))
268 (define* (load-linux-module* file
269 #:key
270 (recursive? #t)
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."
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))
286 (define (load-dependencies file)
287 (let ((dependencies (module-dependencies file)))
288 (every (cut load-linux-module* <>
289 #:lookup-module lookup-module
290 #:black-list black-list)
291 (map lookup-module dependencies))))
293 (and (not (black-listed? (file-name->module-name file)))
294 (or (not recursive?)
295 (load-dependencies file))
296 (let ((fd #f))
297 (format (current-module-debugging-port)
298 "loading Linux module from '~a'...~%" file)
300 (catch 'system-error
301 (lambda ()
302 (set! fd (open-fdes file O_RDONLY))
303 (load-linux-module/fd fd)
304 (close-fdes fd)
305 #t)
306 (lambda args
307 ;; If this module was already loaded and we're in modprobe style, ignore
308 ;; the error.
309 (when fd (close-fdes fd))
310 (or (and recursive? (= EEXIST (system-error-errno args)))
311 (apply throw args)))))))
313 \f
314 ;;;
315 ;;; Device modules.
316 ;;;
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)
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)))
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))))))
347 ;; See 'major' and 'minor' in <sys/sysmacros.h>.
349 (define (stat->device-major st)
350 (ash (logand #xfff00 (stat:rdev st)) -8))
352 (define (stat->device-minor st)
353 (logand #xff (stat:rdev st)))
355 (define %not-slash
356 (char-set-complement (char-set #\/)))
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))))))
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:
372 (device-module-aliases \"/dev/sda\")
373 => (\"scsi:t-0x00\" \"pci:v00008086d00009D03sv0000103Csd000080FAbc01sc06i01\")
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))))))))
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:
411 (string->compiled-sglob \"scsi:t-0x01*\")
413 and each module is a module name like \"snd_hda_intel\"."
414 (define (comment? str)
415 (string-prefix? "#" str))
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)))))
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)
436 (loop (alist-cons (string->compiled-sglob alias) module
437 aliases)))
438 (() ;empty line
439 (loop aliases)))))))
441 (define (current-kernel-directory)
442 "Return the directory of the currently running Linux kernel."
443 (string-append (or (getenv "LINUX_MODULE_DIRECTORY")
444 "/run/booted-system/kernel/lib/modules")
445 "/" (utsname:release (uname))))
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"))
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))
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))
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))
477 (if aliases
478 (let* ((modules (delete-duplicates
479 (append-map (cut matching-modules <> aliases)
480 (device-module-aliases device))))
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 '()))
489 ;;; linux-modules.scm ends here