;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (guix elf)
#:use-module (guix glob)
#:use-module (guix build syscalls)
+ #:use-module ((guix build utils) #:select (find-files invoke))
+ #:use-module (guix build union)
+ #:autoload (zlib) (call-with-gzip-input-port)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 ftw)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
+ #:autoload (ice-9 pretty-print) (pretty-print)
#:export (dot-ko
ensure-dot-ko
+ module-formal-name
module-aliases
module-dependencies
+ module-soft-dependencies
+ normalize-module-name
+ file-name->module-name
+ find-module-file
recursive-module-dependencies
modules-loaded
module-loaded?
load-linux-module*
+ load-linux-modules-from-directory
current-module-debugging-port
device-module-aliases
known-module-aliases
- matching-modules))
+ matching-modules
+ missing-modules
+
+ write-module-name-database
+ write-module-alias-database
+ write-module-device-database
+
+ make-linux-module-directory))
;;; Commentary:
;;;
(define (section-contents elf section)
"Return the contents of SECTION in ELF as a bytevector."
- (let* ((modinfo (elf-section-by-name elf ".modinfo"))
- (contents (make-bytevector (elf-section-size modinfo))))
- (bytevector-copy! (elf-bytes elf) (elf-section-offset modinfo)
+ (let ((contents (make-bytevector (elf-section-size section))))
+ (bytevector-copy! (elf-bytes elf) (elf-section-offset section)
contents 0
- (elf-section-size modinfo))
+ (elf-section-size section))
contents))
(define %not-nul
(cons (string->symbol (string-take str =))
(string-drop str (+ 1 =)))))
+;; Matches kernel modules, without compression, with GZIP compression or with
+;; XZ compression.
+(define module-regex "\\.ko(\\.gz|\\.xz)?$")
+
(define (modinfo-section-contents file)
"Return the contents of the '.modinfo' section of FILE as a list of
key/value pairs.."
- (let* ((bv (call-with-input-file file get-bytevector-all))
+ (define (get-bytevector file)
+ (cond
+ ((string-suffix? ".ko.gz" file)
+ (let ((port (open-file file "r0")))
+ (dynamic-wind
+ (lambda ()
+ #t)
+ (lambda ()
+ (call-with-gzip-input-port port get-bytevector-all))
+ (lambda ()
+ (close-port port)))))
+ (else
+ (call-with-input-file file get-bytevector-all))))
+
+ (let* ((bv (get-bytevector file))
(elf (parse-elf bv))
- (modinfo (section-contents elf ".modinfo")))
+ (section (elf-section-by-name elf ".modinfo"))
+ (modinfo (section-contents elf section)))
(map key=value->pair
(nul-separated-string->list (utf8->string modinfo)))))
(define %not-comma
(char-set-complement (char-set #\,)))
+(define (module-formal-name file)
+ "Return the module name of FILE as it appears in its info section. Usually
+the module name is the same as the base name of FILE, modulo hyphens and minus
+the \".ko[.gz|.xz]\" extension."
+ (match (assq 'name (modinfo-section-contents file))
+ (('name . name) name)
+ (#f #f)))
+
(define (module-dependencies file)
"Return the list of modules that FILE depends on. The returned list
contains module names, not actual file names."
(('depends . what)
(string-tokenize what %not-comma)))))
+(define not-softdep-whitespace
+ (char-set-complement (char-set #\space #\tab)))
+
+(define (module-soft-dependencies file)
+ "Return the list of modules that can be preloaded, and then the list of
+modules that can be postloaded, of the soft dependencies of module FILE."
+ ;; TEXT: "pre: baz blubb foo post: bax bar"
+ (define (parse-softdep text)
+ (let loop ((value '())
+ (tokens (string-tokenize text not-softdep-whitespace))
+ (section #f))
+ (match tokens
+ ((token rest ...)
+ (if (string=? (string-take-right token 1) ":") ; section
+ (loop value rest (string-trim-both (string-drop-right token 1)))
+ (loop (cons (cons section token) value) rest section)))
+ (()
+ value))))
+
+ ;; Note: Multiple 'softdep sections are allowed.
+ (let* ((info (modinfo-section-contents file))
+ (entries (concatenate
+ (filter-map (match-lambda
+ (('softdep . value)
+ (parse-softdep value))
+ (_ #f))
+ (modinfo-section-contents file)))))
+ (let-values (((pres posts)
+ (partition (match-lambda
+ (("pre" . _) #t)
+ (("post" . _) #f))
+ entries)))
+ (values (map (match-lambda
+ ((_ . value) value))
+ pres)
+ (map (match-lambda
+ ((_ . value) value))
+ posts)))))
+
(define (module-aliases file)
"Return the list of aliases of module FILE."
(let ((info (modinfo-section-contents file)))
(_ #f))
(modinfo-section-contents file))))
-(define dot-ko
- (cut string-append <> ".ko"))
-
-(define (ensure-dot-ko name)
- "Return NAME with a '.ko' prefix appended, unless it already has it."
- (if (string-suffix? ".ko" name)
+(define (strip-extension filename)
+ (let ((extension (string-index filename #\.)))
+ (if extension
+ (string-take filename extension)
+ filename)))
+
+(define (dot-ko name compression)
+ (let ((suffix (match compression
+ ('xz ".ko.xz")
+ ('gzip ".ko.gz")
+ (else ".ko"))))
+ (string-append name suffix)))
+
+(define (ensure-dot-ko name compression)
+ "Return NAME with a '.ko[.gz|.xz]' suffix appended, unless it already has
+it."
+ (if (string-contains name ".ko")
name
- (dot-ko name)))
+ (dot-ko name compression)))
(define (normalize-module-name module)
"Return the \"canonical\" name for MODULE, replacing hyphens with
module))
(define (file-name->module-name file)
- "Return the module name corresponding to FILE, stripping the trailing '.ko'
-and normalizing it."
- (normalize-module-name (basename file ".ko")))
+ "Return the module name corresponding to FILE, stripping the trailing
+'.ko[.gz|.xz]' and normalizing it."
+ (normalize-module-name (strip-extension (basename file))))
+
+(define (find-module-file directory module)
+ "Lookup module NAME under DIRECTORY, and return its absolute file name.
+NAME can be a file name with or without '.ko', or it can be a module name.
+Raise an error if it could not be found.
+
+Module names can differ from file names in interesting ways; for instance,
+module names usually (always?) use underscores as the inter-word separator,
+whereas file names often, but not always, use hyphens. Examples:
+\"usb-storage.ko\", \"serpent_generic.ko\"."
+ (define names
+ ;; List of possible file names. XXX: It would of course be cleaner to
+ ;; have a database that maps module names to file names and vice versa,
+ ;; but everyone seems to be doing hacks like this one. Oh well!
+ (delete-duplicates
+ (list module
+ (normalize-module-name module)
+ (string-map (lambda (chr) ;converse of 'normalize-module-name'
+ (case chr
+ ((#\_) #\-)
+ (else chr)))
+ module))))
+
+ (match (find-files directory
+ (lambda (file stat)
+ (member (strip-extension
+ (basename file)) names)))
+ ((file)
+ file)
+ (()
+ (error "kernel module not found" module directory))
+ ((_ ...)
+ (error "several modules by that name" module directory))))
(define* (recursive-module-dependencies files
#:key (lookup-module dot-ko))
(recursive? #t)
(lookup-module dot-ko)
(black-list (module-black-list)))
- "Load Linux module from FILE, the name of a '.ko' file; return true on
-success, false otherwise. When RECURSIVE? is true, load its dependencies
+ "Load Linux module from FILE, the name of a '.ko[.gz|.xz]' file; return true
+on success, false otherwise. When RECURSIVE? is true, load its dependencies
first (à la 'modprobe'.) The actual files containing modules depended on are
obtained by calling LOOKUP-MODULE with the module name. Modules whose name
appears in BLACK-LIST are not loaded."
(or (and recursive? (= EEXIST (system-error-errno args)))
(apply throw args)))))))
+(define (load-linux-modules-from-directory modules directory)
+ "Load MODULES and their dependencies from DIRECTORY, a directory containing
+the '.ko' files. The '.ko' suffix is automatically added to MODULES if
+needed."
+ (define module-name->file-name
+ (module-name-lookup directory))
+
+ (for-each (lambda (module)
+ (load-linux-module* (module-name->file-name module)
+ #:lookup-module module-name->file-name))
+ modules))
+
\f
;;;
;;; Device modules.
module)))
known-aliases))
+(define* (missing-modules device modules-provided)
+ "Assuming MODULES-PROVIDED lists kernel modules that are already
+provided--e.g., in the initrd, return the list of missing kernel modules that
+are required to access DEVICE."
+ (define aliases
+ ;; Attempt to load 'modules.alias' from the current kernel, assuming we're
+ ;; on Guix System, and assuming that corresponds to the kernel we'll be
+ ;; installing.
+ (known-module-aliases))
+
+ (if aliases
+ (let* ((modules (delete-duplicates
+ (append-map (cut matching-modules <> aliases)
+ (device-module-aliases device))))
+
+ ;; Module names (not file names) are supposed to use underscores
+ ;; instead of hyphens. MODULES is a list of module names, whereas
+ ;; LINUX-MODULES is file names without '.ko', so normalize them.
+ (provided (map file-name->module-name modules-provided)))
+ (remove (cut member <> provided) modules))
+ '()))
+
+\f
+;;;
+;;; Module databases.
+;;;
+
+(define* (module-name->file-name/guess directory name
+ #:key compression)
+ "Guess the file name corresponding to NAME, a module name. That doesn't
+always work because sometimes underscores in NAME map to hyphens (e.g.,
+\"input-leds.ko\"), sometimes not (e.g., \"mac_hid.ko\"). If the module is
+compressed then COMPRESSED can be set to 'xz or 'gzip, depending on the
+compression type."
+ (string-append directory "/" (ensure-dot-ko name compression)))
+
+(define (module-name-lookup directory)
+ "Return a one argument procedure that takes a module name (e.g.,
+\"input_leds\") and returns its absolute file name (e.g.,
+\"/.../input-leds.ko\")."
+ (define (guess-file-name name)
+ (let ((names (list
+ (module-name->file-name/guess directory name)
+ (module-name->file-name/guess directory name
+ #:compression 'xz)
+ (module-name->file-name/guess directory name
+ #:compression 'gzip))))
+ (or (find file-exists? names)
+ (first names))))
+
+ (catch 'system-error
+ (lambda ()
+ (define mapping
+ (call-with-input-file (string-append directory "/modules.name")
+ read))
+
+ (lambda (name)
+ (or (assoc-ref mapping name)
+ (guess-file-name name))))
+ (lambda args
+ (if (= ENOENT (system-error-errno args))
+ (cut guess-file-name <>)
+ (apply throw args)))))
+
+(define (write-module-name-database directory)
+ "Write a database that maps \"module names\" as they appear in the relevant
+ELF section of '.ko[.gz|.xz]' files, to actual file names. This format is
+Guix-specific. It aims to deal with inconsistent naming, in particular
+hyphens vs. underscores."
+ (define mapping
+ (map (lambda (file)
+ (match (module-formal-name file)
+ (#f (cons (strip-extension (basename file)) file))
+ (name (cons name file))))
+ (find-files directory module-regex)))
+
+ (call-with-output-file (string-append directory "/modules.name")
+ (lambda (port)
+ (display ";; Module name to file name mapping.
+;;
+;; This format is Guix-specific; it is not supported by upstream Linux tools.
+\n"
+ port)
+ (pretty-print mapping port))))
+
+(define (write-module-alias-database directory)
+ "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding
+'modules.alias' file."
+ (define aliases
+ (map (lambda (file)
+ (cons (file-name->module-name file) (module-aliases file)))
+ (find-files directory module-regex)))
+
+ (call-with-output-file (string-append directory "/modules.alias")
+ (lambda (port)
+ (display "# Aliases extracted from modules themselves.\n" port)
+ (for-each (match-lambda
+ ((module . aliases)
+ (for-each (lambda (alias)
+ (format port "alias ~a ~a\n" alias module))
+ aliases)))
+ aliases))))
+
+(define (aliases->device-tuple aliases)
+ "Traverse ALIASES, a list of module aliases, and search for
+\"char-major-M-N\", \"block-major-M-N\", or \"devname:\" aliases. When they
+are found, return a tuple (DEVNAME TYPE MAJOR MINOR), otherwise return #f."
+ (define (char/block-major? alias)
+ (or (string-prefix? "char-major-" alias)
+ (string-prefix? "block-major-" alias)))
+
+ (define (char/block-major->tuple alias)
+ (match (string-tokenize alias %not-dash)
+ ((type "major" (= string->number major) (= string->number minor))
+ (list (match type
+ ("char" "c")
+ ("block" "b"))
+ major minor))))
+
+ (let* ((devname (any (lambda (alias)
+ (and (string-prefix? "devname:" alias)
+ (string-drop alias 8)))
+ aliases))
+ (major/minor (match (find char/block-major? aliases)
+ (#f #f)
+ (str (char/block-major->tuple str)))))
+ (and devname major/minor
+ (cons devname major/minor))))
+
+(define %not-dash
+ (char-set-complement (char-set #\-)))
+
+(define (write-module-device-database directory)
+ "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding
+'modules.devname' file. This file contains information about modules that can
+be loaded on-demand, such as file system modules."
+ (define aliases
+ (filter-map (lambda (file)
+ (match (aliases->device-tuple (module-aliases file))
+ (#f #f)
+ (tuple (cons (file-name->module-name file) tuple))))
+ (find-files directory module-regex)))
+
+ (call-with-output-file (string-append directory "/modules.devname")
+ (lambda (port)
+ (display "# Device nodes to trigger on-demand module loading.\n" port)
+ (for-each (match-lambda
+ ((module devname type major minor)
+ (format port "~a ~a ~a~a:~a~%"
+ module devname type major minor)))
+ aliases))))
+
+(define (depmod version directory)
+ "Given an (existing) DIRECTORY, invoke depmod on it for
+kernel version VERSION."
+ (let ((destination-directory (string-append directory "/lib/modules/"
+ version))
+ ;; Note: "System.map" is an input file.
+ (maps-file (string-append directory "/System.map"))
+ ;; Note: "Module.symvers" is an input file.
+ (symvers-file (string-append directory "/Module.symvers")))
+ ;; These files will be regenerated by depmod below.
+ (for-each (lambda (basename)
+ (when (and (string-prefix? "modules." basename)
+ ;; Note: "modules.builtin" is an input file.
+ (not (string=? "modules.builtin" basename))
+ ;; Note: "modules.order" is an input file.
+ (not (string=? "modules.order" basename)))
+ (delete-file (string-append destination-directory "/"
+ basename))))
+ (scandir destination-directory))
+ (invoke "depmod"
+ "-e" ; Report symbols that aren't supplied
+ ;"-w" ; Warn on duplicates
+ "-b" directory
+ "-F" maps-file
+ ;"-E" symvers-file ; using both "-E" and "-F" is not possible.
+ version)))
+
+(define (make-linux-module-directory inputs version output)
+ "Create a new directory OUTPUT and ensure that the directory
+OUTPUT/lib/modules/VERSION can be used as a source of Linux
+kernel modules for the first kmod in PATH now to eventually
+load. Take modules to put into OUTPUT from INPUTS.
+
+Right now that means it creates @code{modules.*.bin} which
+@command{modprobe} will use to find loadable modules."
+ (union-build output inputs #:create-all-directories? #t)
+ (depmod version output))
+
;;; linux-modules.scm ends here
HCoop / jackhill / guix / guix.git / blobdiff