[bug#30604] [PATCH v9 1/7] linux-modules: Add "modules.devname" and "modules.alias" writer.

[Danny Milosavljevic]

* gnu/build/linux-modules.scm (write-module-alias-database): New procedure.
(write-module-device-database): New procedure.
(%not-dash): New variable.
---
 gnu/build/linux-modules.scm | 58 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 4fe673cca..0aaf2ff6f 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -36,6 +36,8 @@
             modules-loaded
             module-loaded?
             load-linux-module*
+            write-module-alias-database
+            write-module-device-database
 
             current-module-debugging-port
 
@@ -380,4 +382,60 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                       module)))
               known-aliases))
 
+(define %not-dash
+  (char-set-complement (char-set #\-)))
+
+(define (write-module-alias-database aliases output)
+  "Install \"modules.alias\" for ALIASES to directory OUTPUT."
+  (call-with-output-file (string-append output "/modules.alias")
+    (lambda (port)
+      (format port
+              "# Aliases extracted from modules themselves.\n")
+      (for-each (match-lambda ((module . aliases)
+                               (for-each (lambda (alias)
+                                           (format port "alias ~a ~a\n" alias
+                                                   module))
+                                         aliases)))
+                aliases))))
+
+(define (write-module-device-database aliases output)
+  "Install \"modules.devname\" for ALIASES to directory OUTPUT."
+  (call-with-output-file (string-append output "/modules.devname")
+    (lambda (port)
+      (format port
+              "# Device nodes to trigger on-demand module loading.\n")
+      (for-each (match-lambda
+                 ((module . aliases)
+                  (let* ((interesting-aliases
+                          ;; Note: there's only one devname and then only one
+                          ;; (char-major|block-major).
+                          (filter-map
+                           (match-lambda
+                            ((? (cut string-prefix? "devname:" <>) alias)
+                             `(devname . ,(string-drop alias (string-length 
"devname:"))))
+                            ((? (cut string-prefix? "char-major-" <>) alias)
+                             `(char-major . ,(string-drop alias (string-length 
"char-major-"))))
+                            ((? (cut string-prefix? "block-major-" <>) alias)
+                             `(block-major . ,(string-drop alias 
(string-length "block-major-"))))
+                            (_ #f))
+                           aliases))
+                         (devname (assq-ref interesting-aliases
+                                            'devname))
+                         (char-major (assq-ref interesting-aliases
+                                               'char-major))
+                         (block-major (assq-ref interesting-aliases
+                                               'block-major)))
+                    (when (and devname char-major)
+                      (let ((parts (string-tokenize char-major %not-dash)))
+                        (match parts
+                         ((major minor)
+                          (format port "~a ~a ~a~a:~a\n" module devname
+                                       "c" major minor)))))
+                    (when (and devname block-major)
+                      (let ((parts (string-tokenize block-major %not-dash)))
+                        (match parts
+                         ((major minor)
+                          (format port "~a ~a ~a~a:~a\n" module devname
+                                       "b" major minor)))))))) aliases))))
+
 ;;; linux-modules.scm ends here