linux-modules.scm 27 KB

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