[bug#30604] [PATCH v11 6/6] linux-modules: Add "modules.devname" writer.

["Ludovic Courtès" <ludo@gnu.org>]

* gnu/build/linux-modules.scm (aliases->device-tuple)
(write-module-device-database): New procedures.

Co-authored-by: Danny Milosavljevic <dannym@scratchpost.org>.
---
 gnu/build/linux-modules.scm | 51 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 55161e026..d3ba2c60a 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -47,6 +47,8 @@
             known-module-aliases
             matching-modules
             write-module-alias-database
+            write-module-device-database
+
             load-needed-linux-modules))
 
 ;;; Commentary:
@@ -415,6 +417,55 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                              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 "/tmp" "/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 (load-needed-linux-modules module-directory)
   "Examine /sys/devices to find out which modules are needed and load those we
 have in MODULE-DIRECTORY.  Return the list of modules loaded, not including
-- 
2.16.2