gnu/build/linux-modules.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu build linux-modules)
  20   #:use-module (guix elf)
  21   #:use-module (rnrs io ports)
  22   #:use-module (rnrs bytevectors)
  23   #:use-module (srfi srfi-1)
  24   #:use-module (srfi srfi-26)
  25   #:use-module (ice-9 vlist)
  26   #:use-module (ice-9 match)
  27   #:export (dot-ko
  28             ensure-dot-ko
  29             module-dependencies
  30             recursive-module-dependencies
  31             modules-loaded
  32             module-loaded?
  33             load-linux-module*
  34
  35             current-module-debugging-port))
  36
  37 ;;; Commentary:
  38 ;;;
  39 ;;; Tools to deal with Linux kernel modules.
  40 ;;;
  41 ;;; Code:
  42
  43 (define current-module-debugging-port
  44   (make-parameter (%make-void-port "w")))
  45
  46 (define (section-contents elf section)
  47   "Return the contents of SECTION in ELF as a bytevector."
  48   (let* ((modinfo  (elf-section-by-name elf ".modinfo"))
  49          (contents (make-bytevector (elf-section-size modinfo))))
  50     (bytevector-copy! (elf-bytes elf) (elf-section-offset modinfo)
  51                       contents 0
  52                       (elf-section-size modinfo))
  53     contents))
  54
  55 (define %not-nul
  56   (char-set-complement (char-set #\nul)))
  57
  58 (define (nul-separated-string->list str)
  59   "Split STR at occurrences of the NUL character and return the resulting
  60 string list."
  61   (string-tokenize str %not-nul))
  62
  63 (define (key=value->pair str)
  64   "Assuming STR has the form \"KEY=VALUE\", return a pair like (KEY
  65 . \"VALUE\")."
  66   (let ((= (string-index str #\=)))
  67     (cons (string->symbol (string-take str =))
  68           (string-drop str (+ 1 =)))))
  69
  70 (define (modinfo-section-contents file)
  71   "Return the contents of the '.modinfo' section of FILE as a list of
  72 key/value pairs.."
  73   (let* ((bv      (call-with-input-file file get-bytevector-all))
  74          (elf     (parse-elf bv))
  75          (modinfo (section-contents elf ".modinfo")))
  76     (map key=value->pair
  77          (nul-separated-string->list (utf8->string modinfo)))))
  78
  79 (define %not-comma
  80   (char-set-complement (char-set #\,)))
  81
  82 (define (module-dependencies file)
  83   "Return the list of modules that FILE depends on.  The returned list
  84 contains module names, not actual file names."
  85   (let ((info (modinfo-section-contents file)))
  86     (match (assq 'depends info)
  87       (('depends . what)
  88        (string-tokenize what %not-comma)))))
  89
  90 (define dot-ko
  91   (cut string-append <> ".ko"))
  92
  93 (define (ensure-dot-ko name)
  94   "Return NAME with a '.ko' prefix appended, unless it already has it."
  95   (if (string-suffix? ".ko" name)
  96       name
  97       (dot-ko name)))
  98
  99 (define* (recursive-module-dependencies files
 100                                         #:key (lookup-module dot-ko))
 101   "Return the topologically-sorted list of file names of the modules depended
 102 on by FILES, recursively.  File names of modules are determined by applying
 103 LOOKUP-MODULE to the module name."
 104   (let loop ((files   files)
 105              (result  '())
 106              (visited vlist-null))
 107     (match files
 108       (()
 109        (delete-duplicates (reverse result)))
 110       ((head . tail)
 111        (let* ((visited? (vhash-assoc head visited))
 112               (deps     (if visited?
 113                             '()
 114                             (map lookup-module (module-dependencies head))))
 115               (visited  (if visited?
 116                             visited
 117                             (vhash-cons head #t visited))))
 118          (loop (append deps tail)
 119                (append result deps) visited))))))
 120
 121 (define %not-newline
 122   (char-set-complement (char-set #\newline)))
 123
 124 (define (modules-loaded)
 125   "Return the list of names of currently loaded Linux modules."
 126   (let* ((contents (call-with-input-file "/proc/modules"
 127                      get-string-all))
 128          (lines    (string-tokenize contents %not-newline)))
 129     (match (map string-tokenize lines)
 130       (((modules . _) ...)
 131        modules))))
 132
 133 (define (module-loaded? module)
 134   "Return #t if MODULE is already loaded.  MODULE must be a Linux module name,
 135 not a file name."
 136   (member module (modules-loaded)))
 137
 138 (define* (load-linux-module* file
 139                              #:key
 140                              (recursive? #t)
 141                              (lookup-module dot-ko))
 142   "Load Linux module from FILE, the name of a `.ko' file.  When RECURSIVE? is
 143 true, load its dependencies first (à la 'modprobe'.)  The actual files
 144 containing modules depended on are obtained by calling LOOKUP-MODULE with the
 145 module name."
 146   (define (slurp module)
 147     ;; TODO: Use 'finit_module' to reduce memory usage.
 148     (call-with-input-file file get-bytevector-all))
 149
 150   (when recursive?
 151     (for-each (cut load-linux-module* <> #:lookup-module lookup-module)
 152               (map lookup-module (module-dependencies file))))
 153
 154   (format (current-module-debugging-port)
 155           "loading Linux module from '~a'...~%" file)
 156
 157   (catch 'system-error
 158     (lambda ()
 159       (load-linux-module (slurp file)))
 160     (lambda args
 161       ;; If this module was already loaded and we're in modprobe style, ignore
 162       ;; the error.
 163       (unless (and recursive? (= EEXIST (system-error-errno args)))
 164         (apply throw args)))))
 165
 166 ;;; linux-modules.scm ends here