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