gnu/build/linux-modules.scm

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