From 2a693b69ca35ee942395e1adf458a666846881fc Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 12 Mar 2018 10:43:15 +0100
Subject: linux-modules: Add "modules.devname" writer.

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

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

(limited to 'gnu/build')

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 9b9fc0d9d8..a73ccaf511 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -51,7 +51,8 @@
             matching-modules
             missing-modules
 
-            write-module-alias-database))
+            write-module-alias-database
+            write-module-device-database))
 
 ;;; Commentary:
 ;;;
@@ -507,4 +508,53 @@ are required to access DEVICE."
                              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
-- 
cgit 1.4.1