system: Add kernel-loadable-modules to operating-system.

* gnu/system.scm (<operating-system>): Add kernel-loadable-modules.
(operating-system-directory-base-entries): Use it.
* doc/guix.texi (operating-system Reference): Document
KERNEL-LOADABLE-MODULES.
* gnu/build/linux-modules.scm (depmod): New procedure.
(make-linux-module-directory): New procedure.  Export it.
* guix/profiles.scm (linux-module-database): New procedure.  Export it.
* gnu/tests/linux-modules.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* gnu/packages/linux.scm (make-linux-libre*)[arguments]<#:phases>[install]:
Disable depmod.  Remove "build" and "source" symlinks.
[native-inputs]: Remove kmod.

7 files changed, 235 insertions, 11 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 92125abccc..6346cf78a1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11221,6 +11221,10 @@ The package object of the operating system kernel to use@footnote{Currently
 only the Linux-libre kernel is supported.  In the future, it will be
 possible to use the GNU@tie{}Hurd.}.
 
+@item @code{kernel-loadable-modules} (default: '())
+A list of objects (usually packages) to collect loadable kernel modules
+from--e.g. @code{(list ddcci-driver-linux)}.
+
 @item @code{kernel-arguments} (default: @code{'("quiet")})
 List of strings or gexps representing additional arguments to pass on
 the command-line of the kernel---e.g., @code{("console=ttyS0")}.
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index a149eff329..aa1c7cfeae 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -22,12 +22,14 @@
   #:use-module (guix elf)
   #:use-module (guix glob)
   #:use-module (guix build syscalls)
-  #:use-module ((guix build utils) #:select (find-files))
+  #:use-module ((guix build utils) #:select (find-files invoke))
+  #:use-module (guix build union)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -56,7 +58,9 @@
 
             write-module-name-database
             write-module-alias-database
-            write-module-device-database))
+            write-module-device-database
+
+            make-linux-module-directory))
 
 ;;; Commentary:
 ;;;
@@ -631,4 +635,42 @@ be loaded on-demand, such as file system modules."
                            module devname type major minor)))
                 aliases))))
 
+(define (depmod version directory)
+  "Given an (existing) DIRECTORY, invoke depmod on it for
+kernel version VERSION."
+  (let ((destination-directory (string-append directory "/lib/modules/"
+                                              version))
+        ;; Note: "System.map" is an input file.
+        (maps-file (string-append directory "/System.map"))
+        ;; Note: "Module.symvers" is an input file.
+        (symvers-file (string-append directory "/Module.symvers")))
+    ;; These files will be regenerated by depmod below.
+    (for-each (lambda (basename)
+                (when (and (string-prefix? "modules." basename)
+                           ;; Note: "modules.builtin" is an input file.
+                           (not (string=? "modules.builtin" basename))
+                           ;; Note: "modules.order" is an input file.
+                           (not (string=? "modules.order" basename)))
+                  (delete-file (string-append destination-directory "/"
+                                              basename))))
+              (scandir destination-directory))
+    (invoke "depmod"
+            "-e" ; Report symbols that aren't supplied
+            ;"-w" ; Warn on duplicates
+            "-b" directory
+            "-F" maps-file
+            ;"-E" symvers-file ; using both "-E" and "-F" is not possible.
+            version)))
+
+(define (make-linux-module-directory inputs version output)
+  "Create a new directory OUTPUT and ensure that the directory
+OUTPUT/lib/modules/VERSION can be used as a source of Linux
+kernel modules for the first kmod in PATH now to eventually
+load.  Take modules to put into OUTPUT from INPUTS.
+
+Right now that means it creates @code{modules.*.bin} which
+@command{modprobe} will use to find loadable modules."
+  (union-build output inputs #:create-all-directories? #t)
+  (depmod version output))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index e391903473..a080745220 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -635,6 +635,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/nfs.scm				\
   %D%/tests/install.scm				\
   %D%/tests/ldap.scm				\
+  %D%/tests/linux-modules.scm			\
   %D%/tests/mail.scm				\
   %D%/tests/messaging.scm			\
   %D%/tests/networking.scm			\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index ffc4776f94..c39c411e3d 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -654,7 +654,6 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
      `(("perl" ,perl)
        ("bc" ,bc)
        ("openssl" ,openssl)
-       ("kmod" ,kmod)
        ("elfutils" ,elfutils)  ; Needed to enable CONFIG_STACK_VALIDATION
        ("flex" ,flex)
        ("bison" ,bison)
@@ -678,6 +677,7 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
                   (guix build utils)
                   (srfi srfi-1)
                   (srfi srfi-26)
+                  (ice-9 ftw)
                   (ice-9 match))
        #:phases
        (modify-phases %standard-phases
@@ -750,8 +750,7 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
            (lambda* (#:key inputs native-inputs outputs #:allow-other-keys)
              (let* ((out    (assoc-ref outputs "out"))
                     (moddir (string-append out "/lib/modules"))
-                    (dtbdir (string-append out "/lib/dtbs"))
-                    (kmod   (assoc-ref (or native-inputs inputs) "kmod")))
+                    (dtbdir (string-append out "/lib/dtbs")))
                ;; Install kernel image, kernel configuration and link map.
                (for-each (lambda (file) (install-file file out))
                          (find-files "." "^(\\.config|bzImage|zImage|Image|vmlinuz|System\\.map|Module\\.symvers)$"))
@@ -763,12 +762,29 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
                ;; Install kernel modules
                (mkdir-p moddir)
                (invoke "make"
-                       (string-append "DEPMOD=" kmod "/bin/depmod")
+                       ;; Disable depmod because the Guix system's module directory
+                       ;; is an union of potentially multiple packages.  It is not
+                       ;; possible to use depmod to usefully calculate a dependency
+                       ;; graph while building only one of those packages.
+                       "DEPMOD=true"
                        (string-append "MODULE_DIR=" moddir)
                        (string-append "INSTALL_PATH=" out)
                        (string-append "INSTALL_MOD_PATH=" out)
                        "INSTALL_MOD_STRIP=1"
-                       "modules_install")))))
+                       "modules_install")
+               (let* ((versions (filter (lambda (name)
+                                          (not (string-prefix? "." name)))
+                                        (scandir moddir)))
+                      (version (match versions
+                                ((x) x))))
+                 ;; There are symlinks to the build and source directory,
+                 ;; both of which will point to target /tmp/guix-build*
+                 ;; and thus not be useful in a profile.  Delete the symlinks.
+                 (false-if-file-not-found
+                  (delete-file (string-append moddir "/" version "/build")))
+                 (false-if-file-not-found
+                  (delete-file (string-append moddir "/" version "/source"))))
+               #t))))
        #:tests? #f))
     (home-page "https://www.gnu.org/software/linux-libre/")
     (synopsis "100% free redistribution of a cleaned Linux kernel")
diff --git a/gnu/system.scm b/gnu/system.scm
index 06c58c27ba..c90d8c6cbc 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -168,6 +169,8 @@
 
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
+  (kernel-loadable-modules operating-system-kernel-loadable-modules
+                    (default '()))                ; list of packages
   (kernel-arguments operating-system-user-kernel-arguments
                     (default '("quiet")))         ; list of gexps/strings
   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
@@ -472,9 +475,16 @@ OS."
   "Return the basic entries of the 'system' directory of OS for use as the
 value of the SYSTEM-SERVICE-TYPE service."
   (let ((locale (operating-system-locale-directory os)))
-    (mlet %store-monad ((kernel -> (operating-system-kernel os))
-                        (initrd -> (operating-system-initrd-file os))
-                        (params    (operating-system-boot-parameters-file os)))
+    (mlet* %store-monad ((kernel -> (operating-system-kernel os))
+                         (modules ->
+                          (operating-system-kernel-loadable-modules os))
+                         (kernel
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)))
+                         (initrd -> (operating-system-initrd-file os))
+                         (params    (operating-system-boot-parameters-file os)))
       (return `(("kernel" ,kernel)
                 ("parameters" ,params)
                 ("initrd" ,initrd)
diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm
new file mode 100644
index 0000000000..39e11587c6
--- /dev/null
+++ b/gnu/tests/linux-modules.scm
@@ -0,0 +1,103 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests linux-modules)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu tests)
+  #:use-module (guix derivations)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:export (%test-loadable-kernel-modules-0
+            %test-loadable-kernel-modules-1
+            %test-loadable-kernel-modules-2))
+
+;;; Commentary:
+;;;
+;;; Test <operating-system> kernel-loadable-modules.
+;;;
+;;; Code:
+
+(define* (module-loader-program os modules)
+  "Return an executable store item that, upon being evaluated, will dry-run
+load MODULES."
+  (program-file
+   "load-kernel-modules.scm"
+   (with-imported-modules (source-module-closure '((guix build utils)))
+     #~(begin
+         (use-modules (guix build utils))
+         (for-each (lambda (module)
+                     (invoke (string-append #$kmod "/bin/modprobe") "-n" "--"
+                             module))
+                   '#$modules)))))
+
+(define* (run-loadable-kernel-modules-test module-packages module-names)
+  "Run a test of an OS having MODULE-PACKAGES, and modprobe MODULE-NAMES."
+  (define os
+    (marionette-operating-system
+     (operating-system
+      (inherit (simple-operating-system))
+      (kernel-loadable-modules module-packages))
+     #:imported-modules '((guix combinators))))
+  (define vm (virtual-machine os))
+  (define (test script)
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+          (define marionette
+            (make-marionette (list #$vm)))
+          (mkdir #$output)
+          (chdir #$output)
+          (test-begin "loadable-kernel-modules")
+          (test-assert "script successfully evaluated"
+            (marionette-eval
+             '(primitive-load #$script)
+             marionette))
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+  (gexp->derivation "loadable-kernel-modules" (test (module-loader-program os module-names))))
+
+(define %test-loadable-kernel-modules-0
+  (system-test
+   (name "loadable-kernel-modules-0")
+   (description "Tests loadable kernel modules facility of <operating-system>
+with no extra modules.")
+   (value (run-loadable-kernel-modules-test '() '()))))
+
+(define %test-loadable-kernel-modules-1
+  (system-test
+   (name "loadable-kernel-modules-1")
+   (description "Tests loadable kernel modules facility of <operating-system>
+with one extra module.")
+   (value (run-loadable-kernel-modules-test
+           (list ddcci-driver-linux)
+           '("ddcci")))))
+
+(define %test-loadable-kernel-modules-2
+  (system-test
+   (name "loadable-kernel-modules-2")
+   (description "Tests loadable kernel modules facility of <operating-system>
+with two extra modules.")
+   (value (run-loadable-kernel-modules-test
+           (list acpi-call-linux-module ddcci-driver-linux)
+           '("acpi_call" "ddcci")))))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0d38b2513f..20a2973579 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -139,7 +140,9 @@
             %current-profile
             ensure-profile-directory
             canonicalize-profile
-            user-friendly-profile))
+            user-friendly-profile
+
+            linux-module-database))
 
 ;;; Commentary:
 ;;;
@@ -1137,6 +1140,51 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+(define (linux-module-database manifest)
+  "Return a derivation that unites all the kernel modules of the manifest
+and creates the dependency graph of all these kernel modules.
+
+This is meant to be used as a profile hook."
+  (define kmod  ; lazy reference
+    (module-ref (resolve-interface '(gnu packages linux)) 'kmod))
+  (define build
+     (with-imported-modules
+     (source-module-closure '((guix build utils)
+                              (gnu build linux-modules)))
+      #~(begin
+          (use-modules (ice-9 ftw)
+                       (ice-9 match)
+                       (srfi srfi-1) ; append-map
+                       (gnu build linux-modules))
+          (let* ((inputs '#$(manifest-inputs manifest))
+                 (module-directories
+                  (map (lambda (directory)
+                         (string-append directory "/lib/modules"))
+                       inputs))
+                 (directory-entries
+                  (lambda (directory)
+                    (scandir directory (lambda (basename)
+                                         (not
+                                           (string-prefix? "." basename))))))
+                 ;; Note: Should usually result in one entry.
+                 (versions (delete-duplicates
+                            (append-map directory-entries
+                                        module-directories))))
+              (match versions
+               ((version)
+                (let ((old-path (getenv "PATH")))
+                  (setenv "PATH" #+(file-append kmod "/bin"))
+                  (make-linux-module-directory inputs version #$output)
+                  (setenv "PATH" old-path)))
+               (_ (error "Specified Linux kernel and Linux kernel modules
+are not all of the same version")))))))
+  (gexp->derivation "linux-module-database" build
+                    #:local-build? #t
+                    #:substitutable? #f
+                    #:properties
+                    `((type . profile-hook)
+                      (hook . linux-module-database))))
+
 (define (xdg-desktop-database manifest)
   "Return a derivation that builds the @file{mimeinfo.cache} database from
 desktop files.  It's used to query what applications can handle a given