[bug#30604] [PATCH v8 2/7] linux-modules: Add install-modules.

[Danny Milosavljevic <dannym@scratchpost.org>]

* gnu/build/linux-modules.scm (install-modules): New procedure.
(%not-dash): New variable.
---
 gnu/build/linux-modules.scm | 52 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 364339df9..af217c974 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -36,6 +36,7 @@
             modules-loaded
             module-loaded?
             load-linux-module*
+            install-module-files
 
             current-module-debugging-port
 
@@ -379,4 +380,55 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                       module)))
               known-aliases))
 
+(define %not-dash
+  (char-set-complement (char-set #\-)))
+
+(define (install-module-files module-files output)
+  "Install MODULE-FILES to OUTPUT.
+Precondition: OUTPUT is an empty directory."
+  (let ((aliases
+         (map (lambda (module-file-name)
+                (format #t "copying '~a'...~%" module-file-name)
+                (copy-file module-file-name
+                           (string-append output "/"
+                                          (basename module-file-name)))
+                `(,(file-name->module-name module-file-name) .
+                  ,(module-aliases module-file-name)))
+              (sort module-files string<))))
+    (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)))
+    (call-with-output-file (string-append output "/modules.devname")
+      (lambda (port)
+        (format port
+                "# Device nodes to trigger on-demand module loading.\n")
+        (let* ((aliases (append-map (match-lambda
+                                     ((module . aliases) aliases))
+                                    aliases))
+               (devname #f))
+          ;; Note: there's only one devname and then only one (char-major|block-major).
+          (for-each
+           (match-lambda
+            (((? (cut string-prefix? "devname:" <>) alias) . value)
+             (set! devname (string-drop value (string-length "devname:"))))
+            (((? (cut string-prefix? "char-major-" <>) alias) . value)
+             (let ((parts (string-tokenize %not-dash)))
+               (match parts
+                      ((a b major minor)
+                       (format port "~a ~a ~a:~a\n" devname "c" major minor)))))
+            (((? (cut string-prefix? "block-major-" <>) alias) . value)
+             (let ((parts (string-tokenize %not-dash)))
+               (match parts
+                      ((a b major minor)
+                       (format port "~a ~a ~a:~a\n" devname "b" major minor)))))
+            (_ #f))
+           aliases))))))
+
 ;;; linux-modules.scm ends here