[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[Danny Milosavljevic]

* guix/profiles.scm (linux-module-database): New procedure.
(%default-profile-hooks): Add it.
* gnu/system.scm (operating-system-profile): Add kernel to what
profile-service-type gives.
* gnu/services.scm (%modprobe-wrapper): Use that profile.
* guix/build/linux-module-build-system.scm (install): Disable DEPMOD.
---
 gnu/services.scm                         |  7 ++-
 gnu/system.scm                           |  8 ++-
 guix/build/linux-module-build-system.scm |  5 +-
 guix/profiles.scm                        | 75 +++++++++++++++++++++++-
 4 files changed, 87 insertions(+), 8 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index 6ee05d4580..2a6d2bc464 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -491,7 +491,12 @@ ACTIVATION-SCRIPT-TYPE."
     (program-file "modprobe"
                   #~(begin
                       (setenv "LINUX_MODULE_DIRECTORY"
-                              "/run/booted-system/kernel/lib/modules")
+                              (if (file-exists?
+                                   "/run/booted-system/profile/lib/modules")
+                                  "/run/booted-system/profile/lib/modules"
+                                  ;; Provides compatibility with previous
+                                  ;; Guix generations.
+                                  "/run/booted-system/kernel/lib/modules"))
                       (apply execl #$modprobe
                              (cons #$modprobe (cdr (command-line))))))))
 
diff --git a/gnu/system.scm b/gnu/system.scm
index a353b1a5c8..66270b38bb 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -887,12 +887,14 @@ we're running in the final root."
 (define* (operating-system-profile os)
   "Return a derivation that builds the system profile of OS."
   (mlet* %store-monad
-      ((services -> (operating-system-services os))
+      ((kernel -> (operating-system-kernel os))
+       (services -> (operating-system-services os))
        (profile (fold-services services
-                               #:target-type profile-service-type)))
+                               #:target-type
+                               profile-service-type)))
     (match profile
       (("profile" profile)
-       (return profile)))))
+       (return (cons kernel profile)))))) ; FIXME: Doesn't work for some reason.  I don't think this place is ever reached.
 
 (define (operating-system-root-file-system os)
   "Return the root file system of OS."
diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm
index cd76df2de7..e4e6993a49 100644
--- a/guix/build/linux-module-build-system.scm
+++ b/guix/build/linux-module-build-system.scm
@@ -60,15 +60,14 @@
 ;; part.
 (define* (install #:key inputs native-inputs outputs #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
-         (moddir (string-append out "/lib/modules"))
-         (kmod (assoc-ref (or native-inputs inputs) "kmod")))
+         (moddir (string-append out "/lib/modules")))
     ;; Install kernel modules
     (mkdir-p moddir)
     (invoke "make" "-C"
             (string-append (assoc-ref inputs "linux-module-builder")
                            "/lib/modules/build")
             (string-append "M=" (getcwd))
-            (string-append "DEPMOD=" kmod "/bin/depmod")
+            "DEPMOD=true" ; disable depmod.
             (string-append "MODULE_DIR=" moddir)
             (string-append "INSTALL_PATH=" out)
             (string-append "INSTALL_MOD_PATH=" out)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index cd3b21e390..fd77392588 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
 ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1125,6 +1126,77 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+(define (linux-module-database manifest)
+  (mlet %store-monad
+    ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules '((guix build utils)
+                               (guix build union))
+       #~(begin
+          (use-modules (srfi srfi-1)
+                       (srfi srfi-26)
+                       (guix build utils)
+                       (guix build union)
+                       (ice-9 ftw)
+                       (ice-9 match))
+          (let* ((inputs '#$(manifest-inputs manifest))
+                 (input-files (lambda (path)
+                                (filter file-exists?
+                                  (map (cut string-append <> path) inputs))))
+                 (module-directories (input-files "/lib/modules"))
+                 (System.maps (input-files "/System.map"))
+                 (Module.symverss (input-files "/Module.symvers"))
+                 (directory-entries (lambda (directory-name)
+                                       (filter (lambda (basename)
+                                                 (not (string-prefix? "."
+                                                                      basename)))
+                                               (scandir directory-name))))
+                 ;; Note: Should result in one entry.
+                 (versions (append-map directory-entries module-directories)))
+              ;; TODO: if len(module-directories) == 1: return module-directories[0]
+              (mkdir-p (string-append #$output "/lib/modules"))
+              ;; Iterate over each kernel version directory (usually one).
+              (for-each (lambda (version)
+                          (let ((destination-directory (string-append #$output "/lib/modules/" version)))
+                            (when (not (file-exists? destination-directory)) ; unique
+                              (union-build destination-directory
+                                           ;; All directories with the same version as us.
+                                           (filter-map (lambda (directory-name)
+                                                         (if (member version
+                                                                     (directory-entries directory-name))
+                                                             (string-append directory-name "/" version)
+                                                             #f))
+                                                       module-directories)
+                                           #:create-all-directories? #t)
+                              ;; Delete generated files (they will be recreated shortly).
+                              (for-each (lambda (basename)
+                                          (when (string-prefix? "modules." basename)
+                                            (false-if-file-not-found
+                                              (delete-file
+                                               (string-append
+                                                destination-directory "/"
+                                                basename)))))
+                                        (directory-entries destination-directory))
+                              (unless (zero? (system* (string-append #$kmod "/bin/depmod")
+                                                      "-e" ; Report symbols that aren't supplied
+                                                      "-w" ; Warn on duplicates
+                                                      "-b" #$output ; destination-directory
+                                                      "-F" (match System.maps
+                                                            ((x) x))
+                                                      "-E" (match Module.symverss
+                                                            ((x) x))
+                                                      version))
+                                (display "FAILED\n" (current-error-port))
+                                (exit #f)))))
+                        versions)
+              (exit #t)))))
+    (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
@@ -1425,7 +1497,8 @@ MANIFEST."
         gtk-im-modules
         texlive-configuration
         xdg-desktop-database
-        xdg-mime-database))
+        xdg-mime-database
+        linux-module-database))
 
 (define* (profile-derivation manifest
                              #:key

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 2070 bytes --]

Hi,

any comments about this patch?

I don't want to just push this to guix master without any discussion since it
establishes an interface that has to keep working for a long time.

Rationale of the patch:

* Make Linux more modular, allowing the user to specify a union of Guix packages
to use as "the kernel" (especially kernel modules).

Summary of the patch:

* Add a profile hook "linux-module-database" which creates the union of all
system packages that have a subdirectory "lib/modules" in their derivation,
then invokes depmod on that union and then provides the result in the system
profile.

* Adapt modprobe to check "lib/modules" inside the system profile, if available.
Fall back to "/run/booted-system/kernel/lib/modules" otherwise.

For the case where a person has just reconfigured Guix but doesn't want to reboot,
modprobe will still work, taking the modules of the old generation (which doesn't
necessarily have Linux kernel modules inside the profile yet--because it doesn't
necessarily have this patch yet.  But maybe it does).

* Adapt operating-system-profile to automatically add the Kernel's modules to
the system profile (since the system profile would be the only place searched,
not doing so would be very bad).

* Adapt linux-build-system not to invoke depmod again.  Also, its worldview
would be incomplete anyway because it wouldn't have the entire system profile.

Open questions:

* Why doesn't operating-system-profile successfully add linux-libre ?
It should.  I don't think Guix ever gets there in the first place. (adding
linux-libre to operating-system's "packages" field manually does work)

* Do we want to have this stuff in the system profile or do we want to have
a "kernel profile" instead or something?  I don't think the latter would help
us much, but if we want it, better do it now.

* Do we want to be able to add kernel modules in this fashion without requiring
a reboot?  If so, that would make the situation a lot more complicated and I
don't see a safe way to do that.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[Giovanni Biscuolo]

[-- Attachment #1: Type: text/plain, Size: 2155 bytes --]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> writes:

[...]

> any comments about this patch?

I still don't understand the internals of Guix to be able to comment
yout patch, anyway...


[...]

> Rationale of the patch:
>
> * Make Linux more modular, allowing the user to specify a union of Guix packages
> to use as "the kernel" (especially kernel modules).

this would be a nice to have feature!

>
> Summary of the patch:
>
> * Add a profile hook "linux-module-database" which creates the union of all
> system packages that have a subdirectory "lib/modules" in their derivation,
> then invokes depmod on that union and then provides the result in the system
> profile.
>
> * Adapt modprobe to check "lib/modules" inside the system profile, if available.
> Fall back to "/run/booted-system/kernel/lib/modules" otherwise.
>
> For the case where a person has just reconfigured Guix but doesn't want to reboot,
> modprobe will still work, taking the modules of the old generation (which doesn't
> necessarily have Linux kernel modules inside the profile yet--because it doesn't
> necessarily have this patch yet.  But maybe it does).
>
> * Adapt operating-system-profile to automatically add the Kernel's modules to
> the system profile (since the system profile would be the only place searched,
> not doing so would be very bad).
>
> * Adapt linux-build-system not to invoke depmod again.  Also, its worldview
> would be incomplete anyway because it wouldn't have the entire system profile.
>
> Open questions:
>
> * Why doesn't operating-system-profile successfully add linux-libre ?
> It should.  I don't think Guix ever gets there in the first place. (adding
> linux-libre to operating-system's "packages" field manually does work)
>
> * Do we want to have this stuff in the system profile or do we want to have
> a "kernel profile" instead or something?  I don't think the latter would help
> us much, but if we want it, better do it now.
>
> * Do we want to be able to add kernel modules in this fashion without requiring
> a reboot?  If so, that would make the situation a lot more complicated and I
> don't see a safe way to do that.

[-- Attachment #2.1: Type: text/plain, Size: 53 bytes --]

-- 
Giovanni Biscuolo

Xelera IT Infrastructures

[-- Attachment #2.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[Giovanni Biscuolo]

[sorry for the double posting, I sent my previuos message incomplete]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> writes:

[...]

> any comments about this patch?

I still don't understand the internals of Guix to be able to comment
your patch, but...

[...]

> Rationale of the patch:
>
> * Make Linux more modular, allowing the user to specify a union of Guix packages
> to use as "the kernel" (especially kernel modules).

this would be a nice to have feature!

[...]

> * Do we want to be able to add kernel modules in this fashion without requiring
> a reboot?  If so, that would make the situation a lot more complicated and I
> don't see a safe way to do that.

maybe I'm asking too much... but would it be possible to load and boot
into the new (or another) kernel from the currently running kernel
without a reboot, via kexec?

something like https://wiki.archlinux.org/index.php/Kexec#Manually but
with a clean stop/restart of system services?

I know it could take some time (and maybe other things to patch) to have
this feature, but maybe it is worth thinking of it in connection with
this design change

Thanks! Gio'

-- 
Giovanni Biscuolo

Xelera IT Infrastructures

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[Ludovic Courtès]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> any comments about this patch?

I commented on an earlier version of this patch at
<https://lists.gnu.org/archive/html/guix-devel/2019-10/msg00514.html>.

Let me know what you think!

> I don't want to just push this to guix master without any discussion since it
> establishes an interface that has to keep working for a long time.

I agree, thanks for the heads-up.

> Open questions:
>
> * Why doesn't operating-system-profile successfully add linux-libre ?

What do you mean?  Currently ‘linux-libre’ is not added to the global
profile, and I think it’s nicer this way (we’re not clobbering the
profile).

> * Do we want to be able to add kernel modules in this fashion without requiring
> a reboot?  If so, that would make the situation a lot more complicated and I
> don't see a safe way to do that.

If we arrange for those kernel modules to show up in
/run/current-system/kernel as I suggested in the message linked above,
it should work (assuming the running kernel and the target kernel are
the same, of course).

Thanks,
Ludo’.

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 919 bytes --]

Hi Ludo,

On Wed, 13 Nov 2019 14:30:56 +0100
Ludovic Courtès <ludo@gnu.org> wrote:

> > * Why doesn't operating-system-profile successfully add linux-libre ?  
> 
> What do you mean?  Currently ‘linux-libre’ is not added to the global
> profile, and I think it’s nicer this way (we’re not clobbering the
> profile).

I've modified it to automatically add linux-libre to the system profile but it
doesn't work for some reason.

> > * Do we want to be able to add kernel modules in this fashion without requiring
> > a reboot?  If so, that would make the situation a lot more complicated and I
> > don't see a safe way to do that.  
> 
> If we arrange for those kernel modules to show up in
> /run/current-system/kernel as I suggested in the message linked above,
> it should work (assuming the running kernel and the target kernel are
> the same, of course).

Hmm... I'll read it now :)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[Danny Milosavljevic]

[-- Attachment #1.1: Type: text/plain, Size: 260 bytes --]

Hi Ludo,

should the following work (patch to guix master attached)?

Because I get 

guix system: error: #<procedure 7f990dded140 at guix/profiles.scm:1538:2 (state)>: invalid G-expression input

on

./pre-inst-env guix system vm /etc/config.scm


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: a.patch --]
[-- Type: text/x-patch, Size: 7267 bytes --]

diff --git a/gnu/system.scm b/gnu/system.scm
index 01baa248a2..9874861041 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -164,6 +164,8 @@
 
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
+  (kernel-module-packages operating-system-kernel-module-packages
+                    (default '()))                ; list of packages
   (kernel-arguments operating-system-user-kernel-arguments
                     (default '("quiet")))         ; list of gexps/strings
   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
@@ -469,9 +471,18 @@ OS."
 value of the SYSTEM-SERVICE-TYPE service."
   (let ((locale (operating-system-locale-directory os)))
     (mlet %store-monad ((kernel -> (operating-system-kernel os))
+                        (kernel-module-packages ->
+                         (operating-system-kernel-module-packages os))
                         (initrd -> (operating-system-initrd-file os))
                         (params    (operating-system-boot-parameters-file os)))
       (return `(("kernel" ,kernel)
+                ("kernel-modules"
+                 ,(profile-derivation
+                   (packages->manifest (cons kernel kernel-module-packages))
+                   ; TODO: system, target.
+                   #:hooks (list linux-module-database)
+                   #:system #f
+                   #:target #f))
                 ("parameters" ,params)
                 ("initrd" ,initrd)
                 ("locale" ,locale))))))   ;used by libc
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0d38b2513f..ecc0d3ae5a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
 ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; 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,77 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+(define (linux-module-database manifest)
+  (mlet %store-monad
+    ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules '((guix build utils)
+                               (guix build union))
+       #~(begin
+          (use-modules (srfi srfi-1)
+                       (srfi srfi-26)
+                       (guix build utils)
+                       (guix build union)
+                       (ice-9 ftw)
+                       (ice-9 match))
+          (let* ((inputs '#$(manifest-inputs manifest))
+                 (input-files (lambda (path)
+                                (filter file-exists?
+                                  (map (cut string-append <> path) inputs))))
+                 (module-directories (input-files "/lib/modules"))
+                 (System.maps (input-files "/System.map"))
+                 (Module.symverss (input-files "/Module.symvers"))
+                 (directory-entries (lambda (directory-name)
+                                       (filter (lambda (basename)
+                                                 (not (string-prefix? "."
+                                                                      basename)))
+                                               (scandir directory-name))))
+                 ;; Note: Should result in one entry.
+                 (versions (append-map directory-entries module-directories)))
+              ;; TODO: if len(module-directories) == 1: return module-directories[0]
+              (mkdir-p (string-append #$output "/lib/modules"))
+              ;; Iterate over each kernel version directory (usually one).
+              (for-each (lambda (version)
+                          (let ((destination-directory (string-append #$output "/lib/modules/" version)))
+                            (when (not (file-exists? destination-directory)) ; unique
+                              (union-build destination-directory
+                                           ;; All directories with the same version as us.
+                                           (filter-map (lambda (directory-name)
+                                                         (if (member version
+                                                                     (directory-entries directory-name))
+                                                             (string-append directory-name "/" version)
+                                                             #f))
+                                                       module-directories)
+                                           #:create-all-directories? #t)
+                              ;; Delete generated files (they will be recreated shortly).
+                              (for-each (lambda (basename)
+                                          (when (string-prefix? "modules." basename)
+                                            (false-if-file-not-found
+                                              (delete-file
+                                               (string-append
+                                                destination-directory "/"
+                                                basename)))))
+                                        (directory-entries destination-directory))
+                              (unless (zero? (system* (string-append #$kmod "/bin/depmod")
+                                                      "-e" ; Report symbols that aren't supplied
+                                                      "-w" ; Warn on duplicates
+                                                      "-b" #$output ; destination-directory
+                                                      "-F" (match System.maps
+                                                            ((x) x))
+                                                      "-E" (match Module.symverss
+                                                            ((x) x))
+                                                      version))
+                                (display "FAILED\n" (current-error-port))
+                                (exit #f)))))
+                        versions)
+              (exit #t)))))
+    (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

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.

[Ludovic Courtès]

Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> guix system: error: #<procedure 7f990dded140 at guix/profiles.scm:1538:2 (state)>: invalid G-expression input

That means you’re using a procedure in a gexp, as in:

  #~(foo bar #$proc)

where ‘proc’ is a procedure.

Given the location info and argument name, we can tell that procedure
comes from ‘profile-derivation’, right…

>      (mlet %store-monad ((kernel -> (operating-system-kernel os))
> +                        (kernel-module-packages ->
> +                         (operating-system-kernel-module-packages os))
>                          (initrd -> (operating-system-initrd-file os))
>                          (params    (operating-system-boot-parameters-file os)))
>        (return `(("kernel" ,kernel)
> +                ("kernel-modules"
> +                 ,(profile-derivation
> +                   (packages->manifest (cons kernel kernel-module-packages))

… here.  ↑

This is because ‘profile-derivation’ is a monadic procedure, so it’s
result is a “monadic value”, which is technically a procedure.

You need to move the ‘profile-derivation’ call within the ‘mlet’.

HTH!

Ludo’.

[bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile

[Mark H Weaver]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> wrote:
> any comments about this patch?
> 
> I don't want to just push this to guix master without any discussion since it
> establishes an interface that has to keep working for a long time.

Thanks very much for bringing this to my attention.

Generally, it looks good to me, although I agree with the suggestions
that Ludovic has made, both here and in the thread on guix-devel:

  https://lists.gnu.org/archive/html/guix-devel/2019-10/msg00514.html

I'm overloaded with other tasks at the moment, so I might not comment on
this thread again, but I expect that I'll be happy with whatever you and
Ludovic can agree on.

      Thanks!
        Mark

[bug#37868] [PATCH v2 0/2] system: Add kernel-module-packages to operating-system and use it.

[Danny Milosavljevic]

Danny Milosavljevic (2):
  build-system/linux-module: Disable depmod.
  system: Add kernel-module-packages to operating-system.

 gnu/system.scm                           | 26 ++++++--
 guix/build/linux-module-build-system.scm |  5 +-
 guix/profiles.scm                        | 76 +++++++++++++++++++++++-
 3 files changed, 99 insertions(+), 8 deletions(-)

[bug#37868] [PATCH v2 1/2] build-system/linux-module: Disable depmod.

[Danny Milosavljevic]

* guix/build/linux-module-build-system.scm (install): Disable depmod.
---
 guix/build/linux-module-build-system.scm | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm
index cd76df2de7..525851372e 100644
--- a/guix/build/linux-module-build-system.scm
+++ b/guix/build/linux-module-build-system.scm
@@ -60,15 +60,14 @@
 ;; part.
 (define* (install #:key inputs native-inputs outputs #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
-         (moddir (string-append out "/lib/modules"))
-         (kmod (assoc-ref (or native-inputs inputs) "kmod")))
+         (moddir (string-append out "/lib/modules")))
     ;; Install kernel modules
     (mkdir-p moddir)
     (invoke "make" "-C"
             (string-append (assoc-ref inputs "linux-module-builder")
                            "/lib/modules/build")
             (string-append "M=" (getcwd))
-            (string-append "DEPMOD=" kmod "/bin/depmod")
+            "DEPMOD=true" ; disable depmod.
             (string-append "MODULE_DIR=" moddir)
             (string-append "INSTALL_PATH=" out)
             (string-append "INSTALL_MOD_PATH=" out)

[bug#37868] [PATCH v2 1/2] build-system/linux-module: Disable depmod.

[Ludovic Courtès]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> * guix/build/linux-module-build-system.scm (install): Disable depmod.

[...]

> -            (string-append "DEPMOD=" kmod "/bin/depmod")
> +            "DEPMOD=true" ; disable depmod.

Could you make the comment something like:

  ;; Disable depmod because X and Y.

Think of our future selves.  :-)

Otherwise LGTM.

Ludo’.

[bug#37868] [PATCH v2 1/2] build-system/linux-module: Disable depmod.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 158 bytes --]

Hi,

>  [comment] Otherwise LGTM.

Pushed only this patch to guix master as commit 12f0aefd1418443823450fdd111259269ad3d9cb.

Thanks for the review!


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v2 2/2] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(operating-system-directory-base-entries): Use it.
* guix/profiles.scm (linux-module-database): New procedure.  Export it.
---
 gnu/system.scm    | 26 +++++++++++++---
 guix/profiles.scm | 76 ++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 97 insertions(+), 5 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 01baa248a2..b1cd278044 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.
 ;;;
@@ -164,6 +165,8 @@
 
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
+  (kernel-module-packages operating-system-kernel-module-packages
+                    (default '()))                ; list of packages
   (kernel-arguments operating-system-user-kernel-arguments
                     (default '("quiet")))         ; list of gexps/strings
   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
@@ -468,10 +471,25 @@ 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)))
-      (return `(("kernel" ,kernel)
+    (mlet* %store-monad ((kernel -> (operating-system-kernel os))
+                         (kernel-module-packages ->
+                          (operating-system-kernel-module-packages os))
+                         (kernel*
+                          (if (null? kernel-module-packages)
+                              kernel
+                              (profile-derivation
+                               (packages->manifest
+                                (cons kernel kernel-module-packages))
+                               #:hooks (list linux-module-database)
+                               #:locales? #f
+                               #:allow-collisions? #f
+                               #:relative-symlinks? #t
+                               ; TODO: system, target.
+                               #:system #f
+                               #:target #f)))
+                         (initrd -> (operating-system-initrd-file os))
+                         (params    (operating-system-boot-parameters-file os)))
+      (return `(("kernel" ,kernel*)
                 ("parameters" ,params)
                 ("initrd" ,initrd)
                 ("locale" ,locale))))))   ;used by libc
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0d38b2513f..3e25cd7639 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,77 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+(define (linux-module-database manifest)
+  (mlet %store-monad
+    ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules '((guix build utils)
+                               (guix build union))
+       #~(begin
+          (use-modules (srfi srfi-1)
+                       (srfi srfi-26)
+                       (guix build utils)
+                       (guix build union)
+                       (ice-9 ftw)
+                       (ice-9 match))
+          (let* ((inputs '#$(manifest-inputs manifest))
+                 (input-files (lambda (path)
+                                (filter file-exists?
+                                  (map (cut string-append <> path) inputs))))
+                 (module-directories (input-files "/lib/modules"))
+                 (System.maps (input-files "/System.map"))
+                 (Module.symverss (input-files "/Module.symvers"))
+                 (directory-entries (lambda (directory-name)
+                                       (filter (lambda (basename)
+                                                 (not (string-prefix? "."
+                                                                      basename)))
+                                               (scandir directory-name))))
+                 ;; Note: Should result in one entry.
+                 (versions (append-map directory-entries module-directories)))
+              ;; TODO: if len(module-directories) == 1: return module-directories[0]
+              (mkdir-p (string-append #$output "/lib/modules"))
+              ;; Iterate over each kernel version directory (usually one).
+              (for-each (lambda (version)
+                          (let ((destination-directory (string-append #$output "/lib/modules/" version)))
+                            (when (not (file-exists? destination-directory)) ; unique
+                              (union-build destination-directory
+                                           ;; All directories with the same version as us.
+                                           (filter-map (lambda (directory-name)
+                                                         (if (member version
+                                                                     (directory-entries directory-name))
+                                                             (string-append directory-name "/" version)
+                                                             #f))
+                                                       module-directories)
+                                           #:create-all-directories? #t)
+                              ;; Delete generated files (they will be recreated shortly).
+                              (for-each (lambda (basename)
+                                          (when (string-prefix? "modules." basename)
+                                            (false-if-file-not-found
+                                              (delete-file
+                                               (string-append
+                                                destination-directory "/"
+                                                basename)))))
+                                        (directory-entries destination-directory))
+                              (unless (zero? (system* (string-append #$kmod "/bin/depmod")
+                                                      "-e" ; Report symbols that aren't supplied
+                                                      "-w" ; Warn on duplicates
+                                                      "-b" #$output ; destination-directory
+                                                      "-F" (match System.maps
+                                                            ((x) x))
+                                                      "-E" (match Module.symverss
+                                                            ((x) x))
+                                                      version))
+                                (display "FAILED\n" (current-error-port))
+                                (exit #f)))))
+                        versions)
+              (exit #t)))))
+    (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

[bug#37868] [PATCH v2 2/2] system: Add kernel-module-packages to operating-system.

[Mathieu Othacehe]

Hello Danny,

Thanks for this patch! A few remarks below.

> +                               ; TODO: system, target.
> +                               #:system #f
> +                               #:target #f)))

We need to figure out what #:system and #:target to pass, otherwise it
will break system compilation with --system and --target. This is
somehow linked to this thread[1].

> +(define (linux-module-database manifest)

This is a rather long and over 80 columns procedure.  Maybe you should
consider split it into several functions.

> +                                (display "FAILED\n" (current-error-port))

This could be more specific and would need to be translated.

Mathieu

[1]: https://lists.gnu.org/archive/html/guix-patches/2019-12/msg00416.html

[bug#37868] [PATCH v2 2/2] system: Add kernel-module-packages to operating-system.

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> * gnu/system.scm (<operating-system>): Add kernel-module-packages.
> (operating-system-directory-base-entries): Use it.
> * guix/profiles.scm (linux-module-database): New procedure.  Export it.

[...]

> +  (kernel-module-packages operating-system-kernel-module-packages
> +                    (default '()))                ; list of packages

Technically we don’t require them to be <package> objects, right?  Any
lowerable object, like <computed-file>, would work?

Thus, I’d be tempted to remove “packages” from the field name.

‘kernel-modules’ is not a good idea because one may assume it’s a list
of .ko file names.  Perhaps ‘kernel-loadable-modules’?

Could you also add an entry in guix.texi?

> +    (mlet* %store-monad ((kernel -> (operating-system-kernel os))
> +                         (kernel-module-packages ->
> +                          (operating-system-kernel-module-packages os))

Please use short names for local variables; ‘modules’ is enough here.

> +                         (kernel*

s/kernel*/kernel/ since there’s no ambiguity.

> +                          (if (null? kernel-module-packages)
> +                              kernel
> +                              (profile-derivation
> +                               (packages->manifest
> +                                (cons kernel kernel-module-packages))
> +                               #:hooks (list linux-module-database)
> +                               #:locales? #f
> +                               #:allow-collisions? #f
> +                               #:relative-symlinks? #t
> +                               ; TODO: system, target.
> +                               #:system #f
> +                               #:target #f)))

You can omit the ‘null?’ case.  Also, rather leave out #:system and
#:target so that they take their default value.

> +(define (linux-module-database manifest)
> +  (mlet %store-monad
> +    ((kmod (manifest-lookup-package manifest "kmod")))

Please add a docstring and make the ‘mlet’ a single line.

> +    (define build
> +      (with-imported-modules '((guix build utils)
> +                               (guix build union))
> +       #~(begin
> +          (use-modules (srfi srfi-1)
> +                       (srfi srfi-26)
> +                       (guix build utils)
> +                       (guix build union)
> +                       (ice-9 ftw)
> +                       (ice-9 match))
> +          (let* ((inputs '#$(manifest-inputs manifest))
> +                 (input-files (lambda (path)
> +                                (filter file-exists?
> +                                  (map (cut string-append <> path) inputs))))

s/path/file/ + use of ‘filter-map’

> +                 (module-directories (input-files "/lib/modules"))
> +                 (System.maps (input-files "/System.map"))
> +                 (Module.symverss (input-files "/Module.symvers"))
                                   ^
Typo.
Also perhaps just ‘maps-file’ and ‘symvers-file’.

> +                 (directory-entries (lambda (directory-name)
> +                                       (filter (lambda (basename)
> +                                                 (not (string-prefix? "."
> +                                                                      basename)))
> +                                               (scandir directory-name))))
> +                 ;; Note: Should result in one entry.
> +                 (versions (append-map directory-entries module-directories)))
> +              ;; TODO: if len(module-directories) == 1: return module-directories[0]
> +              (mkdir-p (string-append #$output "/lib/modules"))
> +              ;; Iterate over each kernel version directory (usually one).
> +              (for-each (lambda (version)
> +                          (let ((destination-directory (string-append #$output "/lib/modules/" version)))
> +                            (when (not (file-exists? destination-directory)) ; unique
> +                              (union-build destination-directory
> +                                           ;; All directories with the same version as us.
> +                                           (filter-map (lambda (directory-name)
> +                                                         (if (member version
> +                                                                     (directory-entries directory-name))
> +                                                             (string-append directory-name "/" version)
> +                                                             #f))
> +                                                       module-directories)
> +                                           #:create-all-directories? #t)
> +                              ;; Delete generated files (they will be recreated shortly).
> +                              (for-each (lambda (basename)
> +                                          (when (string-prefix? "modules." basename)
> +                                            (false-if-file-not-found
> +                                              (delete-file
> +                                               (string-append
> +                                                destination-directory "/"
> +                                                basename)))))
> +                                        (directory-entries destination-directory))
> +                              (unless (zero? (system* (string-append #$kmod "/bin/depmod")
> +                                                      "-e" ; Report symbols that aren't supplied
> +                                                      "-w" ; Warn on duplicates
> +                                                      "-b" #$output ; destination-directory
> +                                                      "-F" (match System.maps
> +                                                            ((x) x))
> +                                                      "-E" (match Module.symverss
> +                                                            ((x) x))
> +                                                      version))
> +                                (display "FAILED\n" (current-error-port))
> +                                (exit #f)))))

Like Mathieu wrote, I think this should be shortened and/or decomposed
in several functions, with all the effects (‘for-each’, ‘when’,
‘unless’) happening at the very end.

I wonder what’s missing form (gnu build linux-modules) to do the
“depmod” bit entirely in Scheme.  It would be nice for several reasons,
one of which is that we wouldn’t need the ‘manifest-lookup-package’
hack, which in turn would allow us to keep this procedure out of (guix
profiles).

Thoughts?

Ludo’.

[bug#37868] [PATCH v2 2/2] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1215 bytes --]

Hi Ludo,

On Sun, 23 Feb 2020 17:36:40 +0100
Ludovic Courtès <ludo@gnu.org> wrote:

> Could you also add an entry in guix.texi?

OK!

> > +                 (module-directories (input-files "/lib/modules"))
> > +                 (System.maps (input-files "/System.map"))
> > +                 (Module.symverss (input-files "/Module.symvers"))  
>                                    ^
> Typo.

Not really.  The file is called "Module.symvers" and those are multiple
"Module.symvers"s.  It's my naming convention for lists.  If we don't
want that then I can change it here.

> I wonder what’s missing form (gnu build linux-modules) to do the
> “depmod” bit entirely in Scheme.

Probably not a lot, but there are quite a few binary cache files (.bin)
generated by depmod and not by us--not sure whether we want to replicate
that complexity given the problems we had even with the initrd stuff.

I'm not sure whether those bin files are mandatory or optional to have.

>  It would be nice for several reasons,
> one of which is that we wouldn’t need the ‘manifest-lookup-package’
> hack, which in turn would allow us to keep this procedure out of (guix
> profiles).

Yeah.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v3] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(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.
(ensure-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.
---
 doc/guix.texi               |   3 ++
 gnu/build/linux-modules.scm |  53 ++++++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/system.scm              |  20 +++++--
 gnu/tests/linux-modules.scm | 102 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  49 ++++++++++++++++-
 6 files changed, 222 insertions(+), 6 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index a66bb3d646..01e2d1ab57 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11197,6 +11197,9 @@ 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.
+
 @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..f5f5a0255c 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 false-if-file-not-found))
+  #: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
+
+            ensure-linux-module-directory!))
 
 ;;; Commentary:
 ;;;
@@ -631,4 +635,49 @@ be loaded on-demand, such as file system modules."
                            module devname type major minor)))
                 aliases))))
 
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  (filter file-exists?
+          (map (lambda (x)
+                 (string-append x path))
+               inputs)))
+
+(define (depmod! kmod inputs destination-directory output version)
+       (let ((System.maps (input-files inputs "/System.map"))
+             (Module.symverss (input-files inputs "/Module.symvers")))
+         ;; Delete generated files (they will be recreated shortly).
+         (for-each (lambda (basename)
+                     (when (string-prefix? "modules." basename)
+                       (false-if-file-not-found
+                        (delete-file
+                         (string-append destination-directory "/" basename)))))
+                   (scandir destination-directory))
+         (invoke (string-append kmod "/bin/depmod")
+                 "-e" ; Report symbols that aren't supplied
+                 "-w" ; Warn on duplicates
+                 "-b" output
+                 "-F" (match System.maps
+                       ((System.map) System.map))
+                 "-E" (match Module.symverss
+                       ((Module.symvers) Module.symvers))
+                 version)))
+
+(define (ensure-linux-module-directory! inputs output version kmod)
+  "Ensures that the directory OUTPUT...VERSION can be used by the Linux
+kernel to load modules via KMOD.  The modules to put into
+OUTPUT...VERSION are taken from INPUTS."
+  (let ((destination-directory (string-append output "/lib/modules/"
+                                              version)))
+    (when (not (file-exists? destination-directory)) ; unique
+      (union-build destination-directory
+       ;; All directories with the same version as us.
+       (filter-map (lambda (directory-name)
+                     (if (member version (scandir directory-name))
+                         (string-append directory-name "/" version)
+                         #f))
+                   (input-files inputs "/lib/modules"))
+       #:create-all-directories? #t)
+      (depmod! kmod inputs destination-directory output version))))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 857345cfad..b25c3ceea5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -631,6 +631,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/system.scm b/gnu/system.scm
index 01baa248a2..17b6e667d5 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.
 ;;;
@@ -164,6 +165,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>
@@ -468,9 +471,20 @@ 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
+                          ;; TODO: system, target.
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)
+                           #:locales? #f
+                           #:allow-collisions? #f
+                           #:relative-symlinks? #t))
+                         (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..f0e92f5c8f
--- /dev/null
+++ b/gnu/tests/linux-modules.scm
@@ -0,0 +1,102 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.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 in-place system reconfiguration: advancing the system generation on a
+;;; running instance of the Guix System.
+;;;
+;;; 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..5274a7f5c2 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,50 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+;; XXX: Dupe in gnu/build/linux-modules.scm .
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  #~(begin
+      (use-modules (srfi srfi-1))
+      (filter file-exists?
+        (map (lambda (x)
+               (string-append x #$path))
+             '#$inputs))))
+
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))
+        #~(begin
+            (use-modules (ice-9 ftw))
+            (use-modules (srfi srfi-1)) ; append-map
+            (use-modules (guix build utils)) ; mkdir-p
+            (use-modules (gnu build linux-modules))
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
+                   (directory-entries
+                    (lambda (directory-name)
+                      (scandir directory-name (lambda (basename)
+                                                (not (string-prefix? "." basename))))))
+                   ;; Note: Should usually result in one entry.
+                   (versions (append-map directory-entries module-directories)))
+                ;; TODO: if len(module-directories) == 1: return module-directories[0]
+                (mkdir-p (string-append #$output "/lib/modules"))
+                ;; Iterate over each kernel version directory (usually one).
+                (for-each (lambda (version)
+                            (ensure-linux-module-directory! inputs #$output version #$kmod))
+                          versions)
+                (exit #t)))))
+    (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

[bug#37868] [PATCH v4] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(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.
(ensure-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.
---
 doc/guix.texi               |   3 ++
 gnu/build/linux-modules.scm |  46 +++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/system.scm              |  20 +++++--
 gnu/tests/linux-modules.scm | 102 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  49 ++++++++++++++++-
 6 files changed, 215 insertions(+), 6 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index a66bb3d646..01e2d1ab57 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11197,6 +11197,9 @@ 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.
+
 @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..004804df36 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 false-if-file-not-found))
+  #: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
+
+            ensure-linux-module-directory!))
 
 ;;; Commentary:
 ;;;
@@ -631,4 +635,42 @@ be loaded on-demand, such as file system modules."
                            module devname type major minor)))
                 aliases))))
 
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  (filter file-exists?
+          (map (lambda (x)
+                 (string-append x path))
+               inputs)))
+
+(define (depmod! kmod inputs destination-directory output version)
+       (let ((System.maps (input-files inputs "/System.map"))
+             (Module.symverss (input-files inputs "/Module.symvers")))
+         (invoke (string-append kmod "/bin/depmod")
+                 "-e" ; Report symbols that aren't supplied
+                 "-w" ; Warn on duplicates
+                 "-b" output
+                 "-F" (match System.maps
+                       ((System.map) System.map))
+                 "-E" (match Module.symverss
+                       ((Module.symvers) Module.symvers))
+                 version)))
+
+(define (ensure-linux-module-directory! inputs output version kmod)
+  "Ensures that the directory OUTPUT...VERSION can be used by the Linux
+kernel to load modules via KMOD.  The modules to put into
+OUTPUT...VERSION are taken from INPUTS."
+  (let ((destination-directory (string-append output "/lib/modules/"
+                                              version)))
+    (when (not (file-exists? destination-directory)) ; unique
+      (union-build destination-directory
+       ;; All directories with the same version as us.
+       (filter-map (lambda (directory-name)
+                     (if (member version (scandir directory-name))
+                         (string-append directory-name "/" version)
+                         #f))
+                   (input-files inputs "/lib/modules"))
+       #:create-all-directories? #t)
+      (depmod! kmod inputs destination-directory output version))))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 857345cfad..b25c3ceea5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -631,6 +631,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/system.scm b/gnu/system.scm
index 01baa248a2..17b6e667d5 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.
 ;;;
@@ -164,6 +165,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>
@@ -468,9 +471,20 @@ 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
+                          ;; TODO: system, target.
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)
+                           #:locales? #f
+                           #:allow-collisions? #f
+                           #:relative-symlinks? #t))
+                         (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..f0e92f5c8f
--- /dev/null
+++ b/gnu/tests/linux-modules.scm
@@ -0,0 +1,102 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.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 in-place system reconfiguration: advancing the system generation on a
+;;; running instance of the Guix System.
+;;;
+;;; 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..5274a7f5c2 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,50 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+;; XXX: Dupe in gnu/build/linux-modules.scm .
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  #~(begin
+      (use-modules (srfi srfi-1))
+      (filter file-exists?
+        (map (lambda (x)
+               (string-append x #$path))
+             '#$inputs))))
+
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))
+        #~(begin
+            (use-modules (ice-9 ftw))
+            (use-modules (srfi srfi-1)) ; append-map
+            (use-modules (guix build utils)) ; mkdir-p
+            (use-modules (gnu build linux-modules))
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
+                   (directory-entries
+                    (lambda (directory-name)
+                      (scandir directory-name (lambda (basename)
+                                                (not (string-prefix? "." basename))))))
+                   ;; Note: Should usually result in one entry.
+                   (versions (append-map directory-entries module-directories)))
+                ;; TODO: if len(module-directories) == 1: return module-directories[0]
+                (mkdir-p (string-append #$output "/lib/modules"))
+                ;; Iterate over each kernel version directory (usually one).
+                (for-each (lambda (version)
+                            (ensure-linux-module-directory! inputs #$output version #$kmod))
+                          versions)
+                (exit #t)))))
+    (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

[bug#37868] [PATCH v4] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1529 bytes --]

Some extra comments:

* I have to really really prevent myself from just making the <operating-system>
field KERNEL a list.  Because that's what happens at runtime anyway.
It's just an union of those things, then it runs depmod.  The separation
into KERNEL and KERNEL-LOADABLE-MODULES is artificial.

* There's a collision warning:

warning: collision encountered:
  /gnu/store/3ar8aym8khxh1rdjf5gxqsk0hv7r9p96-linux-module-database/lib/modules/5.4.22-gnu/modules.symbols.bin
  /gnu/store/4r0fz0f37bp1zqbqclgrq1l4sm1acy4p-linux-libre-5.4.22/lib/modules/5.4.22-gnu/modules.symbols.bin
warning: choosing /gnu/store/3ar8aym8khxh1rdjf5gxqsk0hv7r9p96-linux-module-database/lib/modules/5.4.22-gnu/modules.symbols.bin

I think that's because the Linux kernel linux-libre we build already has those
files.  Those files in linux-libre are stale cache files when you have extra
modules (because they don't list those extra modules).

@Ludo: You said I should remove the null? case (check if there are no extra modules).

I did, so actually, these modules.*.bin files in linux-libre are useless since
the profile-derivation of linux-module-database will rebuild them anyway (via
depmod), also in the case with no extra modules.

The reason I had the null? case before is in order to leave the case with no
extra modules unchanged from before (defensive programming).

But now that we don't do that, should we make linux-libre not invoke depmod?
Or should we filter those files out manually in the profile hook?

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v4] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1566 bytes --]

> I think that's because the Linux kernel linux-libre we build already has those
> files.  Those files in linux-libre are stale cache files when you have extra
> modules (because they don't list those extra modules).

It is.  Setting DEPMOD=true in the "install" phase of make-linux-libre* makes
almost all of those go away, except for the ones for "build" and "source".

The latter point to /tmp/guix-build*linux-libre*, so we could just remove those,
too.

diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 78182555c1..d1be57fded 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -760,12 +760,14 @@ 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")
+                       "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")
+               ;; TODO: delete-file moddir/*/build, moddir/*/source (they are symlinks to tmp files anyway)
+                       ))))
        #:tests? #f))
     (home-page "https://www.gnu.org/software/linux-libre/")
     (synopsis "100% free redistribution of a cleaned Linux kernel")

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v5] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(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.
(ensure-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.
---
 doc/guix.texi               |   3 ++
 gnu/build/linux-modules.scm |  54 ++++++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/packages/linux.scm      |  19 ++++++-
 gnu/system.scm              |  20 +++++--
 gnu/tests/linux-modules.scm | 103 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  49 ++++++++++++++++-
 7 files changed, 241 insertions(+), 8 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index a66bb3d646..01e2d1ab57 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11197,6 +11197,9 @@ 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.
+
 @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..69a4b75a08 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 false-if-file-not-found))
+  #: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
+
+            ensure-linux-module-directory!))
 
 ;;; Commentary:
 ;;;
@@ -631,4 +635,50 @@ be loaded on-demand, such as file system modules."
                            module devname type major minor)))
                 aliases))))
 
+(define (input-files inputs file)
+  "Given a list of directories INPUTS, return all entries with FILE in it."
+  ;; TODO: Use filter-map.
+  (filter file-exists?
+          (map (lambda (x)
+                 (string-append x file))
+               inputs)))
+
+(define (depmod! kmod inputs destination-directory output version)
+       (let ((maps-files (input-files inputs "/System.map"))
+             (symvers-files (input-files inputs "/Module.symvers")))
+         (for-each (lambda (basename)
+                     (when (and (string-prefix? "modules." basename)
+                                (not (string=? "modules.builtin" basename))
+                                (not (string=? "modules.order" basename)))
+                       (false-if-file-not-found
+                        (delete-file
+                         (string-append destination-directory "/" basename)))))
+                   (scandir destination-directory))
+         (invoke (string-append kmod "/bin/depmod")
+                 "-e" ; Report symbols that aren't supplied
+                 "-w" ; Warn on duplicates
+                 "-b" output
+                 "-F" (match maps-files
+                       ((System.map) System.map))
+                 "-E" (match symvers-files
+                       ((Module.symvers) Module.symvers))
+                 version)))
+
+(define (ensure-linux-module-directory! inputs output version kmod)
+  "Ensures that the directory OUTPUT...VERSION can be used by the Linux
+kernel to load modules via KMOD.  The modules to put into
+OUTPUT...VERSION are taken from INPUTS."
+  (let ((destination-directory (string-append output "/lib/modules/"
+                                              version)))
+    (when (not (file-exists? destination-directory)) ; unique
+      (union-build destination-directory
+       ;; All directories with the same version as us.
+       (filter-map (lambda (directory-name)
+                     (if (member version (scandir directory-name))
+                         (string-append directory-name "/" version)
+                         #f))
+                   (input-files inputs "/lib/modules"))
+       #:create-all-directories? #t)
+      (depmod! kmod inputs destination-directory output version))))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 857345cfad..b25c3ceea5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -631,6 +631,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 78182555c1..32b802bab4 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -675,6 +675,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
@@ -760,12 +761,26 @@ 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))))
+                 (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 01baa248a2..17b6e667d5 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.
 ;;;
@@ -164,6 +165,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>
@@ -468,9 +471,20 @@ 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
+                          ;; TODO: system, target.
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)
+                           #:locales? #f
+                           #:allow-collisions? #f
+                           #:relative-symlinks? #t))
+                         (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..4a79ed5550
--- /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 in-place system reconfiguration: advancing the system generation on a
+;;; running instance of the Guix System.
+;;;
+;;; 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..5274a7f5c2 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,50 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+;; XXX: Dupe in gnu/build/linux-modules.scm .
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  #~(begin
+      (use-modules (srfi srfi-1))
+      (filter file-exists?
+        (map (lambda (x)
+               (string-append x #$path))
+             '#$inputs))))
+
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))
+        #~(begin
+            (use-modules (ice-9 ftw))
+            (use-modules (srfi srfi-1)) ; append-map
+            (use-modules (guix build utils)) ; mkdir-p
+            (use-modules (gnu build linux-modules))
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
+                   (directory-entries
+                    (lambda (directory-name)
+                      (scandir directory-name (lambda (basename)
+                                                (not (string-prefix? "." basename))))))
+                   ;; Note: Should usually result in one entry.
+                   (versions (append-map directory-entries module-directories)))
+                ;; TODO: if len(module-directories) == 1: return module-directories[0]
+                (mkdir-p (string-append #$output "/lib/modules"))
+                ;; Iterate over each kernel version directory (usually one).
+                (for-each (lambda (version)
+                            (ensure-linux-module-directory! inputs #$output version #$kmod))
+                          versions)
+                (exit #t)))))
+    (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

[bug#37868] [PATCH v5] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 423 bytes --]

> +                ;; Iterate over each kernel version directory (usually one).

It might make sense not to iterate but rather to insist that there be only one
kernel version directory in that profile derivation.

The reason is that it would catch misconfiguration (modules for the wrong
kernel would not be able to be configured into guix system, instead of failing
at runtime because it's in the wrong directory)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v6] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(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.
---
 doc/guix.texi               |   3 ++
 gnu/build/linux-modules.scm |  45 +++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/packages/linux.scm      |  19 ++++++-
 gnu/system.scm              |  20 +++++--
 gnu/tests/linux-modules.scm | 103 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  51 +++++++++++++++++-
 7 files changed, 234 insertions(+), 8 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index a66bb3d646..01e2d1ab57 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11197,6 +11197,9 @@ 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.
+
 @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..bbdf14fab7 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 false-if-file-not-found))
+  #: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,41 @@ be loaded on-demand, such as file system modules."
                            module devname type major minor)))
                 aliases))))
 
+(define (input-files inputs file)
+  "Given a list of directories INPUTS, return all entries with FILE in it."
+  ;; TODO: Use filter-map.
+  (filter file-exists?
+          (map (lambda (x)
+                 (string-append x file))
+               inputs)))
+
+(define (depmod! kmod inputs version destination-directory output)
+  (let ((maps-files (input-files inputs "/System.map"))
+        (symvers-files (input-files inputs "/Module.symvers")))
+    (for-each (lambda (basename)
+                (when (and (string-prefix? "modules." basename)
+                           (not (string=? "modules.builtin" basename))
+                           (not (string=? "modules.order" basename)))
+                  (delete-file (string-append destination-directory "/"
+                                              basename))))
+              (scandir destination-directory))
+    (invoke (string-append kmod "/bin/depmod")
+            "-e" ; Report symbols that aren't supplied
+            "-w" ; Warn on duplicates
+            "-b" output
+            "-F" (match maps-files
+                  ((System.map) System.map))
+            "-E" (match symvers-files
+                  ((Module.symvers) Module.symvers))
+            version)))
+
+(define (make-linux-module-directory kmod inputs version output)
+  "Ensures that the directory OUTPUT...VERSION can be used by the Linux
+kernel to load modules via KMOD.  The modules to put into
+OUTPUT are taken from INPUTS."
+  (let ((destination-directory (string-append output "/lib/modules")))
+    (union-build destination-directory (input-files inputs "/lib/modules")
+                 #:create-all-directories? #t)
+    (depmod! kmod inputs version destination-directory output)))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 857345cfad..b25c3ceea5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -631,6 +631,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 78182555c1..32b802bab4 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -675,6 +675,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
@@ -760,12 +761,26 @@ 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))))
+                 (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 01baa248a2..17b6e667d5 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.
 ;;;
@@ -164,6 +165,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>
@@ -468,9 +471,20 @@ 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
+                          ;; TODO: system, target.
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)
+                           #:locales? #f
+                           #:allow-collisions? #f
+                           #:relative-symlinks? #t))
+                         (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..4a79ed5550
--- /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 in-place system reconfiguration: advancing the system generation on a
+;;; running instance of the Guix System.
+;;;
+;;; 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..6d4aee3586 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,52 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+;; XXX: Dupe in gnu/build/linux-modules.scm .
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  #~(begin
+      (use-modules (srfi srfi-1))
+      (filter file-exists?
+        (map (lambda (x)
+               (string-append x #$path))
+             '#$inputs))))
+
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))
+        #~(begin
+            (use-modules (ice-9 ftw))
+            (use-modules (ice-9 match))
+            (use-modules (srfi srfi-1)) ; append-map
+            (use-modules (guix build utils)) ; mkdir-p
+            (use-modules (gnu build linux-modules))
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
+                   (directory-entries
+                    (lambda (directory-name)
+                      (scandir directory-name (lambda (basename)
+                                                (not (string-prefix? "." basename))))))
+                   ;; Note: Should usually result in one entry.
+                   (versions (delete-duplicates
+                              (append-map directory-entries
+                                          module-directories))))
+                ;; TODO: if len(module-directories) == 1: return module-directories[0]
+                (mkdir-p (string-append #$output "/lib"))
+                (match versions
+                 ((version)
+                  (make-linux-module-directory #$kmod inputs version #$output)))
+                (exit #t)))))
+    (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

[bug#37868] [PATCH v7] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(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.
---
 doc/guix.texi               |   3 ++
 gnu/build/linux-modules.scm |  46 +++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/packages/linux.scm      |  19 ++++++-
 gnu/system.scm              |  20 +++++--
 gnu/tests/linux-modules.scm | 103 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  50 ++++++++++++++++-
 7 files changed, 234 insertions(+), 8 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index a66bb3d646..01e2d1ab57 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11197,6 +11197,9 @@ 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.
+
 @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..fa8f639bb7 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 (input-files inputs file)
+  "Given a list of directories INPUTS, return all entries with FILE in it."
+  ;; TODO: Use filter-map.
+  (filter file-exists?
+          (map (lambda (x)
+                 (string-append x file))
+               inputs)))
+
+(define (depmod! kmod inputs version output)
+  "Given an (existing) OUTPUT directory, invoke KMOD's depmod on it for
+kernel version VERSION."
+  (let ((destination-directory (string-append output "/lib/modules/" version))
+        (maps-files (input-files inputs "/System.map"))
+        (symvers-files (input-files inputs "/Module.symvers")))
+    (for-each (lambda (basename)
+                (when (and (string-prefix? "modules." basename)
+                           (not (string=? "modules.builtin" basename))
+                           (not (string=? "modules.order" basename)))
+                  (delete-file (string-append destination-directory "/"
+                                              basename))))
+              (scandir destination-directory))
+    (invoke (string-append kmod "/bin/depmod")
+            "-e" ; Report symbols that aren't supplied
+            "-w" ; Warn on duplicates
+            "-b" output
+            "-F" (match maps-files
+                  ((System.map) System.map))
+            "-E" (match symvers-files
+                  ((Module.symvers) Module.symvers))
+            version)))
+
+(define (make-linux-module-directory kmod inputs version output)
+  "Ensure that the directory OUTPUT...VERSION can be used by the Linux
+kernel to load modules via KMOD.  The modules to put into
+OUTPUT are taken from INPUTS."
+  (union-build output inputs #:create-all-directories? #t)
+  (depmod! kmod inputs version output))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 857345cfad..b25c3ceea5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -631,6 +631,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 78182555c1..32b802bab4 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -675,6 +675,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
@@ -760,12 +761,26 @@ 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))))
+                 (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 01baa248a2..17b6e667d5 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.
 ;;;
@@ -164,6 +165,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>
@@ -468,9 +471,20 @@ 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
+                          ;; TODO: system, target.
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)
+                           #:locales? #f
+                           #:allow-collisions? #f
+                           #:relative-symlinks? #t))
+                         (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..4a79ed5550
--- /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 in-place system reconfiguration: advancing the system generation on a
+;;; running instance of the Guix System.
+;;;
+;;; 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..add486556f 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)))))
 
+;; XXX: Dupe in gnu/build/linux-modules.scm .
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  #~(begin
+      (use-modules (srfi srfi-1))
+      (filter file-exists?
+        (map (lambda (x)
+               (string-append x #$path))
+             '#$inputs))))
+
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))
+        #~(begin
+            (use-modules (ice-9 ftw))
+            (use-modules (ice-9 match))
+            (use-modules (srfi srfi-1)) ; append-map
+            (use-modules (guix build utils)) ; mkdir-p
+            (use-modules (gnu build linux-modules))
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
+                   (directory-entries
+                    (lambda (directory-name)
+                      (scandir directory-name (lambda (basename)
+                                                (not (string-prefix? "." basename))))))
+                   ;; Note: Should usually result in one entry.
+                   (versions (delete-duplicates
+                              (append-map directory-entries
+                                          module-directories))))
+                ;; TODO: if len(module-directories) == 1: return module-directories[0]
+                (match versions
+                 ((version)
+                  (make-linux-module-directory #$kmod inputs version #$output)))
+                (exit #t)))))
+    (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

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(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.
(input-files): New procedure.
* 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.
---
 doc/guix.texi               |   3 ++
 gnu/build/linux-modules.scm |  41 ++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/packages/linux.scm      |  19 ++++++-
 gnu/system.scm              |  20 +++++--
 gnu/tests/linux-modules.scm | 102 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  48 ++++++++++++++++-
 7 files changed, 226 insertions(+), 8 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index a66bb3d646..01e2d1ab57 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11197,6 +11197,9 @@ 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.
+
 @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..0b11c52103 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,37 @@ be loaded on-demand, such as file system modules."
                            module devname type major minor)))
                 aliases))))
 
+(define (depmod! kmod version output)
+  "Given an (existing) OUTPUT directory, invoke KMOD's depmod on it for
+kernel version VERSION."
+  (let ((destination-directory (string-append output "/lib/modules/" version))
+        ;; Note: "System.map" is an input file.
+        (maps-file (string-append output "/System.map"))
+        ;; Note: "Module.symvers" is an input file.
+        (symvers-file (string-append output "/Module.symvers")))
+    (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 (string-append kmod "/bin/depmod")
+            "-e" ; Report symbols that aren't supplied
+            ;"-w" ; Warn on duplicates
+            "-b" output
+            "-F" maps-file
+            "-E" symvers-file
+            version)))
+
+(define (make-linux-module-directory kmod 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 KMOD to eventually load.  Take modules to
+put into OUTPUT from INPUTS."
+  (union-build output inputs #:create-all-directories? #t)
+  (depmod! kmod version output))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 857345cfad..b25c3ceea5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -631,6 +631,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 78182555c1..32b802bab4 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -675,6 +675,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
@@ -760,12 +761,26 @@ 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))))
+                 (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 01baa248a2..17b6e667d5 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.
 ;;;
@@ -164,6 +165,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>
@@ -468,9 +471,20 @@ 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
+                          ;; TODO: system, target.
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)
+                           #:locales? #f
+                           #:allow-collisions? #f
+                           #:relative-symlinks? #t))
+                         (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..82b9627639
--- /dev/null
+++ b/gnu/tests/linux-modules.scm
@@ -0,0 +1,102 @@
+;;; 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..e39067db04 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,49 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  #~(begin
+      (use-modules (srfi srfi-1))
+      (filter file-exists?
+        (map (lambda (x)
+               (string-append x #$path))
+             '#$inputs))))
+
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))
+        #~(begin
+            (use-modules (ice-9 ftw))
+            (use-modules (ice-9 match))
+            (use-modules (srfi srfi-1)) ; append-map
+            (use-modules (guix build utils)) ; mkdir-p
+            (use-modules (gnu build linux-modules)) ; make-linux-module-directory
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
+                   (directory-entries
+                    (lambda (directory-name)
+                      (scandir directory-name (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)
+                  (make-linux-module-directory #$kmod inputs version #$output)))
+                (exit #t)))))
+    (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

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1443 bytes --]

Hello,

I'd like to push the patch to master on tuesday (with some minimal changes
to the commit message).

The only part I'm still unsure about is:

                          ;; TODO: system, target.
                          (profile-derivation
                           (packages->manifest
                            (cons kernel modules))
                           #:hooks (list linux-module-database)
                           #:locales? #f
                           #:allow-collisions? #f
                           #:relative-symlinks? #t))

Will Guix do the derivation (especially the invocation of depmod) for the
intended system and target?

Apparently, module-init-tools are supposed to be cross-platform anyway and work
when invoking depmod for files of an other architecture than the architecture
depmod is invoked on (and was compiled for).  So maybe we can also just ignore
the entire system/target propagation in this case.

To test that, I tried

  ./pre-inst-env guix build -s armhf-linux -m etc/system-tests.scm

and that seems to hang while compiling the kernel (?).

I'm confident that that has no connection to the patch because it hangs earlier
(at "AR      drivers/net/built-in.a").

Then I tried

  ./pre-inst-env guix build --target=xxx -m etc/system-tests.scm

and that seems to ignore target entirely.

[1] http://lists.busybox.net/pipermail/uclibc/2005-May/032671.html

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Mathieu Othacehe]

Hello Danny,

> Will Guix do the derivation (especially the invocation of depmod) for the
> intended system and target?

Yes, "profile-derivation" should use the current system or target if the
#:system and #:target arguments are #f.

> Apparently, module-init-tools are supposed to be cross-platform anyway and work
> when invoking depmod for files of an other architecture than the architecture
> depmod is invoked on (and was compiled for).  So maybe we can also just ignore
> the entire system/target propagation in this case.

In that case, you should use #+kmod instead of #$kmod. This way, when
cross-compiling, the native kmod would be used.

> Then I tried
>
>   ./pre-inst-env guix build --target=xxx -m etc/system-tests.scm
>
> and that seems to ignore target entirely.

I'm not sure this has ever been tested. Support of cross-compilation for
Guix System is still wip, even if since a few days, core-updates is in a
good shape.

Anyway, if you're willing to wait a few days, I can test your patch does
not break system cross-compilation on core-updates.

Regarding --system, producing disk-images is currently broken on all
branches[1], so it will be harder to test it for now.

Also, here are a few remarks about your patch.

+(define (depmod! kmod version output)
+  "Given an (existing) OUTPUT directory, invoke KMOD's depmod on it for
+kernel version VERSION."

"OUTPUT" is maybe not the best naming as you read multiple "input" files
from it. Maybe just "DIRECTORY"?

+  (let ((destination-directory (string-append output "/lib/modules/" version))
+        ;; Note: "System.map" is an input file.
+        (maps-file (string-append output "/System.map"))
+        ;; Note: "Module.symvers" is an input file.
+        (symvers-file (string-append output "/Module.symvers")))
+    (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))))

You can maybe add a comment explaining what's the point of this
operation.

+              (scandir destination-directory))
+    (invoke (string-append kmod "/bin/depmod")
+            "-e" ; Report symbols that aren't supplied
+            ;"-w" ; Warn on duplicates
+            "-b" output
+            "-F" maps-file
+            "-E" symvers-file

The man page of depmod says that '-F' and '-E' options are mutually
exclusive.

+               (let* ((versions (filter (lambda (name)
+                                          (not (string-prefix? "." name)))
+                                        (scandir moddir)))
+                      (version (match versions
+                                ((x) x))))

If versions only contains one element, then you can use find instead of
filtering and matching.

+                          ;; TODO: system, target.
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)
+                           #:locales? #f
+                           #:allow-collisions? #f
+                           #:relative-symlinks? #t))
+                         (initrd -> (operating-system-initrd-file os))
+                         (params    (operating-system-boot-parameters-file os)))

As stated above, I think you are fine removing the TODO.

+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  #~(begin
+      (use-modules (srfi srfi-1))
+      (filter file-exists?
+        (map (lambda (x)
+               (string-append x #$path))
+             '#$inputs))))
+

This TODO can be resolved I think :)

+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))
+        #~(begin
+            (use-modules (ice-9 ftw))
+            (use-modules (ice-9 match))
+            (use-modules (srfi srfi-1)) ; append-map
+            (use-modules (guix build utils)) ; mkdir-p
+            (use-modules (gnu build linux-modules)) ; make-linux-module-directory
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
+                   (directory-entries
+                    (lambda (directory-name)
+                      (scandir directory-name (lambda (basename)
+                                                (not (string-prefix? "." basename))))))
+                   ;; Note: Should usually result in one entry.
+                   (versions (delete-duplicates
+                              (append-map directory-entries
+                                          module-directories))))

This part is over the column limit.

+                (match versions
+                 ((version)
+                  (make-linux-module-directory #$kmod inputs version #$output)))

If depmod output is system agnostic, then we should use
#+kmod. If that's not the case, this will be an issue as running #$kmod
won't work when cross-compiling.

Thanks,

Mathieu

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Mathieu Othacehe]

> Regarding --system, producing disk-images is currently broken on all
> branches[1], so it will be harder to test it for now.

And the forgotten link!

[1]: https://lists.gnu.org/archive/html/guix-devel/2019-12/msg00099.html

Mathieu

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1486 bytes --]

Hi Mathieu,

On Sun, 15 Mar 2020 11:28:37 +0100
Mathieu Othacehe <m.othacehe@gmail.com> wrote:

> Yes, "profile-derivation" should use the current system or target if the
> #:system and #:target arguments are #f.

OK!

> In that case, you should use #+kmod instead of #$kmod. This way, when
> cross-compiling, the native kmod would be used.

> Anyway, if you're willing to wait a few days, I can test your patch does
> not break system cross-compilation on core-updates.

Sure.

> The man page of depmod says that '-F' and '-E' options are mutually
> exclusive.

Linus Torvalds seems to be in favor of not supporting Module.symvers anymore,
so let's use "-F"...

> 
> +               (let* ((versions (filter (lambda (name)
> +                                          (not (string-prefix? "." name)))
> +                                        (scandir moddir)))
> +                      (version (match versions
> +                                ((x) x))))
> 
> If versions only contains one element, then you can use find instead of
> filtering and matching.

I don't really know that it only contains one element.  In normal supported
operation it should--but if the user does something stupid (put kernel
version A and module version B into the operating-system, where A != B),
I want it to fail and not depmod half the things (neither all the things, for
that matter).

> As stated above, I think you are fine removing the TODO.

Cool!

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Mathieu Othacehe]

Hello Danny,

I tested you patch by cross-compiling a simple system for
aarch64-gnu-linux with:

--8<---------------cut here---------------start------------->8---
(kernel-loadable-modules (list acpi-call-linux-module))
--8<---------------cut here---------------end--------------->8---

However, I have the following error:

--8<---------------cut here---------------start------------->8---
guix system: error: gnu/packages/linux.scm:886:2: acpi-call-linux-module@3.17: build system `linux-module' does not support cross builds
--8<---------------cut here---------------end--------------->8---

This is not caused by your patch, but it prevents me from testing :(

Thanks,

Mathieu

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 792 bytes --]

Hi Mathieu,

On Mon, 16 Mar 2020 10:55:57 +0100
Mathieu Othacehe <m.othacehe@gmail.com> wrote:

> --8<---------------cut here---------------start------------->8---
> guix system: error: gnu/packages/linux.scm:886:2: acpi-call-linux-module@3.17: build system `linux-module' does not support cross builds
> --8<---------------cut here---------------end--------------->8---
> 
> This is not caused by your patch, but it prevents me from testing :(

That's too bad.

I tried to preserve cross-compilation in guix/build-system/linux-module.scm
but apparently I missed something.  Sorry!

It could just be the

  (not target)                               ;XXX: no cross-compilation

in guix/build-system/linux-module.scm - because the other file should support
it just fine.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> On Mon, 16 Mar 2020 10:55:57 +0100
> Mathieu Othacehe <m.othacehe@gmail.com> wrote:
>
>> --8<---------------cut here---------------start------------->8---
>> guix system: error: gnu/packages/linux.scm:886:2: acpi-call-linux-module@3.17: build system `linux-module' does not support cross builds
>> --8<---------------cut here---------------end--------------->8---
>> 
>> This is not caused by your patch, but it prevents me from testing :(
>
> That's too bad.
>
> I tried to preserve cross-compilation in guix/build-system/linux-module.scm
> but apparently I missed something.  Sorry!
>
> It could just be the
>
>   (not target)                               ;XXX: no cross-compilation

Yes, it means that ‘linux-module-build-system’ does not return a bag
when cross-compiling.

See ‘gnu-build-system’ for how to support cross-compilation.

In the meantime, Mathieu, perhaps you can test system cross-compilation
by using a ‘computed-file’ (instead of a package) as a fake package
providing modules?

Thanks,
Ludo’.

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Mathieu Othacehe]

Hello Danny,

> It could just be the
>
>   (not target)                               ;XXX: no cross-compilation
>
> in guix/build-system/linux-module.scm - because the other file should support
> it just fine.

Removing the (not target) is enough to make it build. However, when
running:

--8<---------------cut here---------------start------------->8---
 guix build --target=aarch64-linux-gnu acpi-call-linux-module
--8<---------------cut here---------------end--------------->8---

the produced module does not seem to be cross-compiled:

--8<---------------cut here---------------start------------->8---
mathieu@meru:~/guix$ file /gnu/store/fkk5cd746xxh1nx4qvi7arzhznf37yxw-acpi-call-linux-module-3.17/lib/modules/5.4.25-gnu/extra/acpi_call.ko 
/gnu/store/fkk5cd746xxh1nx4qvi7arzhznf37yxw-acpi-call-linux-module-3.17/lib/modules/5.4.25-gnu/extra/acpi_call.ko: ELF 64-bit LSB relocatable, x86-64, version 1 (SYSV), BuildID[sha1]=a1d9e0ec7b8ef5096a4e1b5c2e7ca6a8bd524cf9, not stripped
--8<---------------cut here---------------end--------------->8---

Thanks,

Mathieu

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 236 bytes --]

Whoops.

weird.  guix/build/linux-module-build-system.scm sets CROSS_COMPILE up so it
should have worked.

Did it print the message

    (format #t "`CROSS_COMPILE' set to `~a'~%"
               (getenv "CROSS_COMPILE")))

?

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 84 bytes --]

Ohhhh, try adding (target target) to the bag in guix/build-system/linux-module.scm

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Ludovic Courtès]

Hey!

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> It could just be the
>>
>>   (not target)                               ;XXX: no cross-compilation
>>
>> in guix/build-system/linux-module.scm - because the other file should support
>> it just fine.
>
> Removing the (not target) is enough to make it build.

But then it’s a native build.  :-)

Ludo’.

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 257 bytes --]

Hi Mathieu,

what happen if there are no kernel-module-packages and one is cross-compiling?

Then (native) depmod should still be invoked on linux-libre's modules.

I think that that case is the most important to test in order to avoid
regressions.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Mathieu Othacehe]

Hello Danny,

> Then (native) depmod should still be invoked on linux-libre's modules.
>
> I think that that case is the most important to test in order to avoid
> regressions.

You are right and it that case, everything seems to work fine! It would
be nice to fix linux-module-build-system cross-compilation, but I think
that it can be done later.

Mathieu

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 325 bytes --]


Hey,

Here's a patch that fixes linux-module-build-system cross-compilation. I
tested it on acpi-call-linux-module, ddcci-driver-linux, vhba-module and
rtl8812au-aircrack-ng-linux-module, seems to work fine!

Now, I'll try to rebase it on top of your patch and see if it works for
a cross-compiled system.

Thanks,

Mathieu

[-- Attachment #2: 0001-build-system-linux-module-Fix-cross-compilation.patch --]
[-- Type: text/x-diff, Size: 12073 bytes --]

From 0331acf8494cc8404a23c0bdd516ef7c5bf854ad Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Fri, 20 Mar 2020 16:01:02 +0100
Subject: [PATCH] build-system: linux-module: Fix cross-compilation.

* guix/build-system/linux-module.scm (default-kmod, default-gcc): Remove as
unused,
(system->arch): new procedure,
(make-linux-module-builder)[native-inputs]: move linux ...
[inputs]: ... to here,
(lower): allow cross-compilation, move "linux" and "linux-module-builder" to
host-inputs, add target-inputs, call linux-module-build-cross if target is
set, linux-module-build otherwise,
(linux-module-build): add a target argument, pass target and arch to
build side linux-module-build call,
(linux-module-build-cross): new procedure.

* guix/build/linux-module-build-system.scm (configure): Add arch argument and
use it to set ARCH environment variable,
(linux-module-build): fill comment.
---
 guix/build-system/linux-module.scm       | 162 +++++++++++++++++------
 guix/build/linux-module-build-system.scm |  17 +--
 2 files changed, 132 insertions(+), 47 deletions(-)

diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index 1e1a07d0a2..ca104f7c75 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -45,27 +46,16 @@
   (let ((module (resolve-interface '(gnu packages linux))))
     (module-ref module 'linux-libre)))
 
-(define (default-kmod)
-  "Return the default kmod package."
-
-  ;; Do not use `@' to avoid introducing circular dependencies.
+(define (system->arch system)
   (let ((module (resolve-interface '(gnu packages linux))))
-    (module-ref module 'kmod)))
-
-(define (default-gcc)
-  "Return the default gcc package."
-
-  ;; Do not use `@' to avoid introducing circular dependencies.
-  (let ((module (resolve-interface '(gnu packages gcc))))
-    (module-ref module 'gcc-7)))
+    ((module-ref module 'system->linux-architecture) system)))
 
 (define (make-linux-module-builder linux)
   (package
     (inherit linux)
     (name (string-append (package-name linux) "-module-builder"))
-    (native-inputs
-     `(("linux" ,linux)
-       ,@(package-native-inputs linux)))
+    (inputs
+     `(("linux" ,linux)))
     (arguments
      (substitute-keyword-arguments (package-arguments linux)
       ((#:phases phases)
@@ -97,33 +87,43 @@
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs))
-
-  (and (not target)                               ;XXX: no cross-compilation
-       (bag
-         (name name)
-         (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
-                        ,@(standard-packages)))
-         (build-inputs `(("linux" ,linux) ; for "Module.symvers".
-                         ("linux-module-builder"
-                         ,(make-linux-module-builder linux))
-                         ,@native-inputs
-                         ;; TODO: Remove "gmp", "mpfr", "mpc" since they are
-                         ;; only needed to compile the gcc plugins.  Maybe
-                         ;; remove "flex", "bison", "elfutils", "perl",
-                         ;; "openssl".  That leaves very little ("bc", "gcc",
-                         ;; "kmod").
-                         ,@(package-native-inputs linux)))
-         (outputs outputs)
-         (build linux-module-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+    `(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs
+      ,@(if target '() '(#:target))))
+
+  (bag
+    (name name)
+    (system system) (target target)
+    (build-inputs `(,@(if source
+                          `(("source" ,source))
+                          '())
+                    ,@native-inputs
+                    ;; TODO: Remove "gmp", "mpfr", "mpc" since they are
+                    ;; only needed to compile the gcc plugins.  Maybe
+                    ;; remove "flex", "bison", "elfutils", "perl",
+                    ;; "openssl".  That leaves very little ("bc", "gcc",
+                    ;; "kmod").
+                    ,@(package-native-inputs linux)
+                    ,@(if target
+                          ;; Use the standard cross inputs of
+                          ;; 'gnu-build-system'.
+                          (standard-cross-packages target 'host)
+                          '())
+                    ;; Keep the standard inputs of 'gnu-build-system'.
+                    ,@(standard-packages)))
+    (host-inputs `(,@inputs
+                   ("linux" ,linux)
+                   ("linux-module-builder"
+                    ,(make-linux-module-builder linux))))
+    (target-inputs (if target
+                       (standard-cross-packages target 'target)
+                       '()))
+    (outputs outputs)
+    (build (if target linux-module-build-cross linux-module-build))
+    (arguments (strip-keyword-arguments private-keywords arguments))))
 
 (define* (linux-module-build store name inputs
                              #:key
+                             target
                              (search-paths '())
                              (tests? #t)
                              (phases '(@ (guix build linux-module-build-system)
@@ -152,6 +152,8 @@
                                            search-paths)
                      #:phases ,phases
                      #:system ,system
+                     #:target ,target
+                     #:arch ,(system->arch (or target system))
                      #:tests? ,tests?
                      #:outputs %outputs
                      #:inputs %build-inputs)))
@@ -173,6 +175,88 @@
                                 #:guile-for-build guile-for-build
                                 #:substitutable? substitutable?))
 
+(define* (linux-module-build-cross
+          store name
+          #:key
+          target native-drvs target-drvs
+          (guile #f)
+          (outputs '("out"))
+          (search-paths '())
+          (native-search-paths '())
+          (tests? #f)
+          (phases '(@ (guix build linux-module-build-system)
+                      %standard-phases))
+          (system (%current-system))
+          (substitutable? #t)
+          (imported-modules
+           %linux-module-build-system-modules)
+          (modules '((guix build linux-module-build-system)
+                     (guix build utils))))
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (let ()
+         (define %build-host-inputs
+           ',(map (match-lambda
+                    ((name (? derivation? drv) sub ...)
+                     `(,name . ,(apply derivation->output-path drv sub)))
+                    ((name path)
+                     `(,name . ,path)))
+                  native-drvs))
+
+         (define %build-target-inputs
+           ',(map (match-lambda
+                    ((name (? derivation? drv) sub ...)
+                     `(,name . ,(apply derivation->output-path drv sub)))
+                    ((name (? package? pkg) sub ...)
+                     (let ((drv (package-cross-derivation store pkg
+                                                          target system)))
+                       `(,name . ,(apply derivation->output-path drv sub))))
+                    ((name path)
+                     `(,name . ,path)))
+                  target-drvs))
+
+         (linux-module-build #:name ,name
+                             #:source ,(match (assoc-ref native-drvs "source")
+                                         (((? derivation? source))
+                                          (derivation->output-path source))
+                                         ((source)
+                                          source)
+                                         (source
+                                          source))
+                             #:system ,system
+                             #:target ,target
+                             #:arch ,(system->arch (or target system))
+                             #:outputs %outputs
+                             #:inputs %build-target-inputs
+                             #:native-inputs %build-host-inputs
+                             #:search-paths
+                             ',(map search-path-specification->sexp
+                                    search-paths)
+                             #:native-search-paths
+                             ',(map
+                                search-path-specification->sexp
+                                native-search-paths)
+                             #:phases ,phases
+                             #:tests? ,tests?))))
+
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system #:graft? #f))
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(gnu packages commencement)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system #:graft? #f)))))
+
+  (build-expression->derivation store name builder
+                                #:system system
+                                #:inputs (append native-drvs target-drvs)
+                                #:outputs outputs
+                                #:modules imported-modules
+                                #:guile-for-build guile-for-build
+                                #:substitutable? substitutable?))
+
 (define linux-module-build-system
   (build-system
     (name 'linux-module)
diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm
index 8145d5a724..73d6b101f6 100644
--- a/guix/build/linux-module-build-system.scm
+++ b/guix/build/linux-module-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,14 +34,13 @@
 ;; Code:
 
 ;; Copied from make-linux-libre's "configure" phase.
-(define* (configure #:key inputs target #:allow-other-keys)
+(define* (configure #:key inputs target arch #:allow-other-keys)
   (setenv "KCONFIG_NOTIMESTAMP" "1")
   (setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH"))
-  ;(let ((arch ,(system->linux-architecture
-  ;                         (or (%current-target-system)
-  ;                             (%current-system)))))
-  ;  (setenv "ARCH" arch)
-  ;  (format #t "`ARCH' set to `~a'~%" (getenv "ARCH")))
+
+  (setenv "ARCH" arch)
+  (format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))
+
   (when target
     (setenv "CROSS_COMPILE" (string-append target "-"))
     (format #t "`CROSS_COMPILE' set to `~a'~%"
@@ -85,8 +85,9 @@
     (replace 'install install)))
 
 (define* (linux-module-build #:key inputs (phases %standard-phases)
-                       #:allow-other-keys #:rest args)
-  "Build the given package, applying all of PHASES in order, with a Linux kernel in attendance."
+                             #:allow-other-keys #:rest args)
+  "Build the given package, applying all of PHASES in order, with a Linux
+kernel in attendance."
   (apply gnu:gnu-build
          #:inputs inputs #:phases phases
          args))
-- 
2.25.1

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Mathieu Othacehe]

Yes I confirm that I'm now able to "modprobe acpi_call" on a
cross-compiled system. Any further test I could run?

Thanks,

Mathieu

Le ven. 20 mars 2020 à 16:13, Mathieu Othacehe <m.othacehe@gmail.com> a écrit :
>
>
> Hey,
>
> Here's a patch that fixes linux-module-build-system cross-compilation. I
> tested it on acpi-call-linux-module, ddcci-driver-linux, vhba-module and
> rtl8812au-aircrack-ng-linux-module, seems to work fine!
>
> Now, I'll try to rebase it on top of your patch and see if it works for
> a cross-compiled system.
>
> Thanks,
>
> Mathieu

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 533 bytes --]

Hi Mathieu,

On Fri, 20 Mar 2020 18:52:20 +0100
Mathieu Othacehe <m.othacehe@gmail.com> wrote:

> Yes I confirm that I'm now able to "modprobe acpi_call" on a
> cross-compiled system. Any further test I could run?

that's great!

That pretty much covers it.

If you want and it's easy for you to do, you can also try

make check-system TESTS="loadable-kernel-modules-0 loadable-kernel-modules-1 loadable-kernel-modules-2"

It tests 0 extra module packages, 1 extra module package, 2 extra module package.

Thanks!

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 221 bytes --]

Hi,

I've verified that the non-cross linux module builder still works.

So I've pushed a variant of your patch (with adjusted commit message) and
also v10 of the guix kernel module patch to guix master.

Thanks!

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Ludovic Courtès]

Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> I've verified that the non-cross linux module builder still works.
>
> So I've pushed a variant of your patch (with adjusted commit message) and
> also v10 of the guix kernel module patch to guix master.

Awesome, thank you!

Ludo’.

[bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.

[Ludovic Courtès]

Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> The only part I'm still unsure about is:
>
>                           ;; TODO: system, target.
>                           (profile-derivation
>                            (packages->manifest
>                             (cons kernel modules))
>                            #:hooks (list linux-module-database)
>                            #:locales? #f
>                            #:allow-collisions? #f
>                            #:relative-symlinks? #t))
>
> Will Guix do the derivation (especially the invocation of depmod) for the
> intended system and target?

I would just write a test OS definition, and then run:

  ./pre-inst-env guix system build test.scm -nd -s armhf-linux

From there, you can inspect the ‘linux-module-database’ derivation,
check its system type, and check the kmod referred to in its “-builder”
file (is it the file name of the armhf-linux kmod?).

Likewise for cross-compilation.

HTH!

Ludo’.

[bug#37868] [PATCH v6] system: Add kernel-module-packages to operating-system.

[Ludovic Courtès]

Hi!

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> * gnu/system.scm (<operating-system>): Add kernel-module-packages.
> (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.

[...]

> +@item @code{kernel-loadable-modules} (default: '())
> +A list of objects (usually packages) to collect loadable kernel modules from.

Perhaps you can add an example.

> +(define (input-files inputs file)
> +  "Given a list of directories INPUTS, return all entries with FILE in it."
> +  ;; TODO: Use filter-map.
> +  (filter file-exists?
> +          (map (lambda (x)
> +                 (string-append x file))
> +               inputs)))

“Input” in Guix is usually used to describe association lists.  To avoid
confusion, I propose:

   (define (existing-files directories base)
     "Return the absolute file name of every file named BASE under the
   DIRECTORIES."
     (filter-map (lambda (directory)
                   (let ((file (string-append directory "/" base)))
                     (and (file-exists? file) file)))
                 inputs)

> +(define (depmod! kmod inputs version destination-directory output)

There’s shouldn’t be a bang, by convention.  Also please add a docstring.

> +  (let ((maps-files (input-files inputs "/System.map"))
> +        (symvers-files (input-files inputs "/Module.symvers")))
> +    (for-each (lambda (basename)
> +                (when (and (string-prefix? "modules." basename)
> +                           (not (string=? "modules.builtin" basename))
> +                           (not (string=? "modules.order" basename)))
> +                  (delete-file (string-append destination-directory "/"
> +                                              basename))))
> +              (scandir destination-directory))
> +    (invoke (string-append kmod "/bin/depmod")

Generally, for this kind of utility function, we assume that the tool is
in $PATH, which allows us to avoid carrying its file name throughout the
API.  I’d suggest doing the same here.

> +(define (make-linux-module-directory kmod inputs version output)
> +  "Ensures that the directory OUTPUT...VERSION can be used by the Linux
> +kernel to load modules via KMOD.  The modules to put into
> +OUTPUT are taken from INPUTS."

Perhaps be more specific as to the fact that it’s creating ‘System.maps’
etc. databases?

>    (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
> +                          ;; TODO: system, target.
> +                          (profile-derivation
> +                           (packages->manifest
> +                            (cons kernel modules))
> +                           #:hooks (list linux-module-database)
> +                           #:locales? #f
> +                           #:allow-collisions? #f
> +                           #:relative-symlinks? #t))

I think the system and target will be correct, but perhaps you can
double-check why doing ‘guix system build -s … -d’ and checking the
relevant .drv.  :-)

I don’t think #:allow-collisions?, #:locales? and #:relative-symlinks?
are needed, so I’d recommend removing them.

> +++ b/gnu/tests/linux-modules.scm

Nice!

> +;; XXX: Dupe in gnu/build/linux-modules.scm .
> +(define (input-files inputs path)
> +  "Given a list of directories INPUTS, return all entries with PATH in it."
> +  ;; TODO: Use filter-map.
> +  #~(begin
> +      (use-modules (srfi srfi-1))
> +      (filter file-exists?
> +        (map (lambda (x)
> +               (string-append x #$path))
> +             '#$inputs))))

Same comment as above.  :-)

> +(define (linux-module-database manifest)
> +  "Return a derivation that unions all the kernel modules in the manifest
> +and creates the dependency graph for all these kernel modules."

Perhaps explicitly write “This is meant to be used as a profile hook.”
or similar.

> +    (define build
> +      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))

80 chars please.  :-)

> +        #~(begin
> +            (use-modules (ice-9 ftw))
> +            (use-modules (ice-9 match))
> +            (use-modules (srfi srfi-1)) ; append-map
> +            (use-modules (guix build utils)) ; mkdir-p
> +            (use-modules (gnu build linux-modules))

Please make it only one ‘use-modules’ form.

> +            (let* ((inputs '#$(manifest-inputs manifest))
> +                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
> +                   (directory-entries
> +                    (lambda (directory-name)
> +                      (scandir directory-name (lambda (basename)
> +                                                (not (string-prefix? "." basename))))))

80 chars please, and also one-word identifiers are preferred for local
variables.

> +                   ;; Note: Should usually result in one entry.
> +                   (versions (delete-duplicates
> +                              (append-map directory-entries
> +                                          module-directories))))
> +                ;; TODO: if len(module-directories) == 1: return module-directories[0]
> +                (mkdir-p (string-append #$output "/lib"))
> +                (match versions
> +                 ((version)
> +                  (make-linux-module-directory #$kmod inputs version #$output)))
> +                (exit #t)))))

No need for ‘exit’, but perhaps and ‘error’ call in the unmatched case?

Thanks, and apologies for the delay!

Ludo’.

[bug#37868] [PATCH v6] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1856 bytes --]

Hi Ludo,

On Sun, 15 Mar 2020 22:00:04 +0100
Ludovic Courtès <ludo@gnu.org> wrote:

> I don’t think #:allow-collisions?, #:locales? and #:relative-symlinks?
> are needed, so I’d recommend removing them.

Removing allow-collisions.

Otherwise the defaults are different.

I'm pretty sure that we don't need locales for Linux kernel modules,
for example :)

That said, I can do it--but it would increase build dependencies.

> > +            (let* ((inputs '#$(manifest-inputs manifest))
> > +                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
> > +                   (directory-entries
> > +                    (lambda (directory-name)
> > +                      (scandir directory-name (lambda (basename)
> > +                                                (not (string-prefix? "." basename))))))  
> 
> also one-word identifiers are preferred for local
> variables.

I'd like to do that but it would lose information here.

"modules" would be too vague.  "directories" would be non-unique.
(What "module-directories" means is "'/lib/modules'-directories", literally)

"entries" would be too vague too.  Entries of what?
(Especially since that's a procedure).

I'll make it say "directory" instead of "directory-name" there.

Note:

The "existing-files" procedure exists only in order to allow us to
build Linux kernels without any modules (neither in linux-libre nor anywhere
else) and have the profile hook succeed.

Maybe it's written in an overly general way for that?  What do you think?

(It's actually kinda bad that I ignore kernel-loadable-modules
which have no "/lib/modules" in it (better would be an error)--but I wasn't
sure whether manifest-inputs is guaranteed to keep the original order of
the entries--which would be: linux-libre first)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v6] system: Add kernel-module-packages to operating-system.

[Ludovic Courtès]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> On Sun, 15 Mar 2020 22:00:04 +0100
> Ludovic Courtès <ludo@gnu.org> wrote:
>
>> I don’t think #:allow-collisions?, #:locales? and #:relative-symlinks?
>> are needed, so I’d recommend removing them.
>
> Removing allow-collisions.
>
> Otherwise the defaults are different.
>
> I'm pretty sure that we don't need locales for Linux kernel modules,
> for example :)

#:locales? tells whether to install locales in the Guile process that
builds the profile so that it can handle non-ASCII file names, for
example.

> That said, I can do it--but it would increase build dependencies.

IMO it matters less than maintainability and conciseness in this case.
:-)

>> > +            (let* ((inputs '#$(manifest-inputs manifest))
>> > +                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
>> > +                   (directory-entries
>> > +                    (lambda (directory-name)
>> > +                      (scandir directory-name (lambda (basename)
>> > +                                                (not (string-prefix? "." basename))))))  
>> 
>> also one-word identifiers are preferred for local
>> variables.
>
> I'd like to do that but it would lose information here.
>
> "modules" would be too vague.  "directories" would be non-unique.
> (What "module-directories" means is "'/lib/modules'-directories", literally)
>
> "entries" would be too vague too.  Entries of what?
> (Especially since that's a procedure).
>
> I'll make it say "directory" instead of "directory-name" there.

Your call.  My point is: if we keep with the general guideline of
keeping functions small, then one-word identifiers are usually good
enough because in the context of the function it should be clear and
non-ambiguous.

> Note:
>
> The "existing-files" procedure exists only in order to allow us to
> build Linux kernels without any modules (neither in linux-libre nor anywhere
> else) and have the profile hook succeed.
>
> Maybe it's written in an overly general way for that?  What do you think?

Yeah, maybe.  It certainly looks weird to me to have a top-level
procedure for something that’s in fact quite specific to the problem at
hand (I realized when attempting to write a docstring that it’s a weird
interface, and that’s because it’s in fact very specific to what we’re
doing here.)

> (It's actually kinda bad that I ignore kernel-loadable-modules
> which have no "/lib/modules" in it (better would be an error)--but I wasn't
> sure whether manifest-inputs is guaranteed to keep the original order of
> the entries--which would be: linux-libre first)

Dunno, I guess it would be fine to error out when
‘kernel-loadable-modules’ is passed a package that doesn’t have any
modules.

Thanks,
Ludo’.

[bug#37868] [PATCH v6] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 392 bytes --]

Hi Mark,

should it be possible to have a kernel without module support in Guix?

Is there a system test already that tests that case?

I ask because I don't know what depmod would do when passed such a kernel.

(I'm trying pretty hard here to not break that case--but actually I don't even
know whether it works in the first place)

Is it easily possible to build such a kernel?

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v6] system: Add kernel-module-packages to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 415 bytes --]

Hi Ludo,

On Sun, 15 Mar 2020 22:00:04 +0100
Ludovic Courtès <ludo@gnu.org> wrote:

> > +    (invoke (string-append kmod "/bin/depmod")  
> 
> Generally, for this kind of utility function, we assume that the tool is
> in $PATH, which allows us to avoid carrying its file name throughout the
> API.  I’d suggest doing the same here.

Hmm, does that mean I should also change PATH in the profile hook?

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#37868] [PATCH v6] system: Add kernel-module-packages to operating-system.

[Ludovic Courtès]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> On Sun, 15 Mar 2020 22:00:04 +0100
> Ludovic Courtès <ludo@gnu.org> wrote:
>
>> > +    (invoke (string-append kmod "/bin/depmod")  
>> 
>> Generally, for this kind of utility function, we assume that the tool is
>> in $PATH, which allows us to avoid carrying its file name throughout the
>> API.  I’d suggest doing the same here.
>
> Hmm, does that mean I should also change PATH in the profile hook?

Yes, I think that’s the only change you have to do:

  (setenv "PATH" #+(file-append kmod "/bin"))

in the profile hook.

HTH,
Ludo’.

[bug#37868] [PATCH v9] system: Add kernel-loadable-modules to operating-system.

[Danny Milosavljevic]

* 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.
---
 doc/guix.texi               |   4 ++
 gnu/build/linux-modules.scm |  46 +++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/packages/linux.scm      |  22 +++++++-
 gnu/system.scm              |  16 ++++--
 gnu/tests/linux-modules.scm | 103 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  48 ++++++++++++++++-
 7 files changed, 232 insertions(+), 8 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 9a5b5f7fbe..4e4bdbf73c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11223,6 +11223,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..56c1991c0b 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 kmod version directory)
+  "Given an (existing) DIRECTORY, invoke KMOD's 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 (string-append kmod "/bin/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 kmod 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 KMOD to eventually load.  Take modules to
+put into OUTPUT from INPUTS.
+
+Right now that means it creates @code{modules.*.bin} which
+modprobe will use to find loadable modules."
+  (union-build output inputs #:create-all-directories? #t)
+  (depmod kmod version output))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 99baddea92..0e068ef17a 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -632,6 +632,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 7f293a9071..7fa72020d8 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -678,6 +678,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
@@ -763,12 +764,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 cfc730a41c..e2a9869e86 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.
 ;;;
@@ -167,6 +168,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>
@@ -471,9 +474,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..6123730498 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,49 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules.
+
+This is meant to be used as a profile hook."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "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
+                         (guix build utils) ; mkdir-p
+                         (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)
+                  (make-linux-module-directory #+kmod inputs version
+                                               #$output))
+                 (_ (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

[bug#37868] [PATCH v10] system: Add kernel-loadable-modules to operating-system.

[Danny Milosavljevic]

* 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.
---
 doc/guix.texi               |   4 ++
 gnu/build/linux-modules.scm |  46 +++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/packages/linux.scm      |  22 +++++++-
 gnu/system.scm              |  16 ++++--
 gnu/tests/linux-modules.scm | 103 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  49 ++++++++++++++++-
 7 files changed, 233 insertions(+), 8 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index c2eff582f8..10fd7b3312 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11226,6 +11226,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 ca3f2664aa..b00e0bcf72 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -633,6 +633,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 0e649d0fe3..1bae26f0a5 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -678,6 +678,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
@@ -763,12 +764,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..c0fd8ddc35 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,50 @@ for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules.
+
+This is meant to be used as a profile hook."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "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

bug#37868: [PATCH v10] system: Add kernel-loadable-modules to operating-system.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 204 bytes --]

Pushed a variant of this to guix master as commit
5c79f238634c5adb6657f1b4b1bb4ddb8bb73ef1.

Changes:

* linux-module-database: Use kmod directly via (gnu packages linux) and not
via the manifest.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]