gnu/build/linux-modules.scm

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