Merge branch 'master' into staging

1 files changed, 146 insertions, 1 deletions

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index c66ef97012..a149eff329 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; 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.
 ;;;
@@ -30,8 +31,10 @@
   #: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
@@ -42,13 +45,18 @@
             modules-loaded
             module-loaded?
             load-linux-module*
+            load-linux-modules-from-directory
 
             current-module-debugging-port
 
             device-module-aliases
             known-module-aliases
             matching-modules
-            missing-modules))
+            missing-modules
+
+            write-module-name-database
+            write-module-alias-database
+            write-module-device-database))
 
 ;;; Commentary:
 ;;;
@@ -95,6 +103,14 @@ key/value pairs.."
 (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\" 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."
@@ -310,6 +326,18 @@ 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))
+
 
 ;;;
 ;;; Device modules.
@@ -486,4 +514,121 @@ are required to access DEVICE."
         (remove (cut member <> provided) modules))
       '()))
 
+
+;;;
+;;; Module databases.
+;;;
+
+(define (module-name->file-name/guess directory name)
+  "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\")."
+  (string-append directory "/" (ensure-dot-ko name)))
+
+(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\")."
+  (catch 'system-error
+    (lambda ()
+      (define mapping
+        (call-with-input-file (string-append directory "/modules.name")
+          read))
+
+      (lambda (name)
+        (or (assoc-ref mapping name)
+            (module-name->file-name/guess directory name))))
+    (lambda args
+      (if (= ENOENT (system-error-errno args))
+          (cut module-name->file-name/guess directory <>)
+          (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' 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 (basename file ".ko") file))
+             (name (cons name file))))
+         (find-files directory "\\.ko$")))
+
+  (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' 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 "\\.ko$")))
+
+  (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' 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 "\\.ko$")))
+
+  (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))))
+
 ;;; linux-modules.scm ends here