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

DoneSubmitted by Danny Milosavljevic.
Details
5 participants
  • Danny Milosavljevic
  • Giovanni Biscuolo
  • Ludovic Courtès
  • Mathieu Othacehe
  • Mark H Weaver
Owner
unassigned
Severity
normal
D
D
Danny Milosavljevic wrote on 22 Oct 2019 17:22
(address . guix-patches@gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20191022152238.12856-1-dannym@scratchpost.org
* 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(-)

Toggle diff (162 lines)
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
D
D
Danny Milosavljevic wrote on 12 Nov 2019 17:20
(address . 37868@debbugs.gnu.org)
20191112172048.61ba69eb@scratchpost.org
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.
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl3K2+AACgkQ5xo1VCww
uqUm7QgAifa//EJFZvzHDhsRmwBHcxu57lTXixAKCKE/AwOUqBLKzwcuhcw7FzMS
+lYtMBncVhAzRQxI+9nINYocY0i2UQVD5UrcQa7DoDvfH897Sfn1IZgq0pJJhzVk
EfGD8iUg9MYez4OucIJCj+iRIKLDuA0Gdr9+ZXtIGY/dCSQEyVpFpi6MtfEhlh6J
HJSqjdr3pmxJb79UTchOYUXQbYO+mV/BQGARriSbIUholojir/PhBg85VvQ4UVAx
SU04apwOIqMeqpuwbwuklNGP/a/YjxXeuf6LPqsyNyUSSOciVaVreZADrlZI741Z
wJg12spSgSWb7naC7IP8F5cnV4F/dw==
=qwvK
-----END PGP SIGNATURE-----


G
G
Giovanni Biscuolo wrote on 12 Nov 2019 18:47
Re: [bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.
874kz9ouk2.fsf@roquette.mug.biscuolo.net
Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> writes:

[...]

Toggle quote (2 lines)
> any comments about this patch?

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


[...]

Toggle quote (5 lines)
> 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!

Toggle quote (36 lines)
>
> 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.
--
Giovanni Biscuolo

Xelera IT Infrastructures
-----BEGIN PGP SIGNATURE-----

iQIzBAEBCgAdFiEERcxjuFJYydVfNLI5030Op87MORIFAl3K8E0ACgkQ030Op87M
ORK7Sw//eY58xlU477UID0nj71YpeDziEtcLhtmDUmlVsg1jcU1/0NNNOuhAw+ys
GRSwR8HXbKTpe1yZgdTo9sszEF1WhEXiTTL2VV1xYj8XtiqwpYDpnwsKYewsBScf
ehHmQBbK7Y91EDpp64sWkCFYS7SB/DaRyChLbgWcQ3/xMw7TtFKpUl/8UZTp6GJM
NV8xtKjVH4dnv554cISppIvArR5DsEAUn+r47KcgxCwdPStNvV//niGNHSw+KFi/
1Y3fy6jZhuooD+SgN0DxlrPCQfqtktlMSxHmocc4PY48o2IScdSAkKuJ8bcnEnxH
2OPcC5+bXfykXDmK4t2paykfUlU/fSSuOMs8DTYvbHO2L2A3Heqfu20EZy4Wg3Ee
9IMGTY8najcfACXvfEt6TcFBfyzOR0NgTsOiCfubk5Lb0S/fHUOmjDlIMdM3mjX1
3DQK8UaAsxnsDaFgloerSXmFsQOmLK+DH6xS5z60TVwPqKbsX5gYo41m2ncCfBsc
rEO/NUsht+EUd3rrLCDPxKG418NOLIaKIFIoAT7mkTzJcr4z+F7PfGImPhtIgmfc
00DYs1Ql8MTeNt/QFJET0yCzvWtMyiRmyrtv8SaVazlGFZIGbD9Xob+pUQedh4Vf
lPjKeADJIpO9buWzOOwJMsKRHhKKh1N+/yzMPjQwe86w7FYnyOk=
=DfZ9
-----END PGP SIGNATURE-----

G
G
Giovanni Biscuolo wrote on 12 Nov 2019 19:11
8736etotg4.fsf@roquette.mug.biscuolo.net
[sorry for the double posting, I sent my previuos message incomplete]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> writes:

[...]

Toggle quote (2 lines)
> any comments about this patch?

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

[...]

Toggle quote (5 lines)
> 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!

[...]

Toggle quote (4 lines)
> * 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?

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
L
L
Ludovic Courtès wrote on 13 Nov 2019 14:30
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87a78zq4xb.fsf@gnu.org
Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (2 lines)
> any comments about this patch?

I commented on an earlier version of this patch at

Let me know what you think!

Toggle quote (3 lines)
> 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.

Toggle quote (4 lines)
> 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).

Toggle quote (4 lines)
> * 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’.
D
D
Danny Milosavljevic wrote on 14 Nov 2019 17:21
(name . Ludovic Courtès)(address . ludo@gnu.org)
20191114172116.7f565f7d@scratchpost.org
Hi Ludo,

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

Toggle quote (6 lines)
> > * 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.

Toggle quote (9 lines)
> > * 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 :)
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl3NfvwACgkQ5xo1VCww
uqU44Af9HixiuyU21XSnM38yd8Vm4aGTOjPuqpEAuVZLI0MelZ3mN4IBrW3xKmlT
iXhiOXxEanWf3LSQHwYp1CXazy83nqBkAFYL1CivxNHDZQpaZd2c3jzI2+Kk4VlJ
mn4DZH4T8FweGsOMOvQ6MzZze8eOdhpRSjAMUzgvQKSFLNzUE+CtRFOuMh9evIQS
lpKq3trSCKhQoZdv/5hpHVFc0ZCUfaXVpl8d5d4ko1VI7irfbQxbFqtU7ms5aQJf
wq7OIXJxcL3XRWE2a/+VU3LqdXP9CJ7QewBMM87QAQT/1wA0aJBjGBabXFM4A0Q9
hAganoZJLz4dOSu5m/KMUqMKmmRYdA==
=iQlv
-----END PGP SIGNATURE-----


M
M
Mark H Weaver wrote on 14 Nov 2019 18:48
Re: [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87tv7673ib.fsf@netris.org
Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> wrote:
Toggle quote (5 lines)
> 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:


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
L
L
Ludovic Courtès wrote on 30 Dec 2019 19:55
Re: Loading modules built using linux-module-build-system
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87sgl163u3.fsf@gnu.org
Hello,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (18 lines)
> On Sun, 17 Nov 2019 21:35:32 +0100
> Ludovic Courtès <ludo@gnu.org> wrote:
>> Rather than a list, we could have a ‘make-linux-libre-union’ procedure
>> returning a <package>, so that we preserve consistent typing.
>>
>> That is, people could write:
>>
>> (kernel linux-libre)
>>
>> or:
>>
>> (kernel (make-linux-libre-union linux-libre some-package))
>>
>> WDYT?
>
> Hmm, isn't it more like a profile? I mean it would work the way above but
> there's (presumably) some reason why SOME-PACKAGE was an extra package.

You’re right, the union thing above is like a profile.

Toggle quote (5 lines)
> We don't have to use the /run/current-system/profile for that, it could be
> a new one.
>
> What are the downside of using a profile vs. using a package in that way?

No downside to using a profile, as long as it’s not
/run/current-system/profile. The only remaining question is the
programming interface.

Possible options include ‘make-linux-libre-union’ above or a new
‘linux-module-packages’ field in <operating-system> as discussed at

HTH,
Ludo’.
D
D
Danny Milosavljevic wrote on 17 Feb 2020 18:10
Re: [bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.
(name . Ludovic Courtès)(address . ludo@gnu.org)
20200217181045.7d41f231@scratchpost.org
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
Toggle diff (133 lines)
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
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5KyRUACgkQ5xo1VCww
uqVEFQf9GFlM7I4B9PGp5AmjpX/P1NtogHcDqRO4Hx457+CAeeJoKj7nLgbIJi8U
2ztELh8Q8AU42Lz6fr5gJd0waswegVGMLd4ohcN9MOKtwtTzu3RoOidkPv1rJkj3
CuOV+Lis3FCVMUR0COVadqbr0wfR/KYLFW5ISR9WnJOeJ/c85/Wuf59upxtk2V72
mcNHKZjMDsgIvRflZC/jd6jf0SqEMHGUJRLQTRiGEtAiJ68w3RGLOEpNGWZv+jQm
C+Vmpnl8WNt7rqKWDRiDFhXx3w2mQP7OncsevUT2JZ2eCSPBxM6n2E5DbvmejGSu
qlIhUBA6jTeq2h8hr30hYTqv5dsGKg==
=UdIf
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 18 Feb 2020 09:31
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87lfp0nvp1.fsf@gnu.org
Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (2 lines)
> 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…

Toggle quote (10 lines)
> (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’.
D
D
Danny Milosavljevic wrote on 18 Feb 2020 10:42
[PATCH v2 0/2] system: Add kernel-module-packages to operating-system and use it.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200218094207.6196-1-dannym@scratchpost.org
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(-)
D
D
Danny Milosavljevic wrote on 18 Feb 2020 10:42
[PATCH v2 1/2] build-system/linux-module: Disable depmod.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200218094207.6196-2-dannym@scratchpost.org
* 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(-)

Toggle diff (22 lines)
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)
D
D
Danny Milosavljevic wrote on 18 Feb 2020 10:42
[PATCH v2 2/2] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200218094207.6196-3-dannym@scratchpost.org
* 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(-)

Toggle diff (152 lines)
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
M
M
Mathieu Othacehe wrote on 18 Feb 2020 13:31
(address . guix-patches@gnu.org)
87pnecnkju.fsf@gmail.com
Hello Danny,

Thanks for this patch! A few remarks below.

Toggle quote (4 lines)
> + ; 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].

Toggle quote (2 lines)
> +(define (linux-module-database manifest)

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

Toggle quote (2 lines)
> + (display "FAILED\n" (current-error-port))

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

Mathieu

L
L
Ludovic Courtès wrote on 23 Feb 2020 17:22
Re: [PATCH v2 1/2] build-system/linux-module: Disable depmod.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87ftf1s28l.fsf@gnu.org
Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

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

[...]

Toggle quote (3 lines)
> - (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’.
L
L
Ludovic Courtès wrote on 23 Feb 2020 17:36
Re: [PATCH v2 2/2] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
875zfxs1k7.fsf@gnu.org
Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (4 lines)
> * 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.

[...]

Toggle quote (3 lines)
> + (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?

Toggle quote (4 lines)
> + (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.

Toggle quote (2 lines)
> + (kernel*

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

Toggle quote (13 lines)
> + (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.

Toggle quote (4 lines)
> +(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.

Toggle quote (15 lines)
> + (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’

Toggle quote (3 lines)
> + (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’.

Toggle quote (43 lines)
> + (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’.
D
D
Danny Milosavljevic wrote on 24 Feb 2020 17:18
(name . Ludovic Courtès)(address . ludo@gnu.org)
20200224171818.039a4cef@scratchpost.org
Hi Ludo,

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

Toggle quote (2 lines)
> Could you also add an entry in guix.texi?

OK!

Toggle quote (6 lines)
> > + (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.

Toggle quote (3 lines)
> 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.

Toggle quote (5 lines)
> 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.
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5T90oACgkQ5xo1VCww
uqX/yQf/b4V7ynuhS+QbYuS4QaJJDw1GAX0RKEBHa4UFEu+uxq3tNVaGqg/Cd2ni
nVprw/XLavSn/nrBkXlinegsptagdX9XeJmDkXMu2YLLIIWfQ7ysY50rhzP2nKjD
NS7H3aljNC7yUFc+QhL2xC2b+kAypRAG2i67BlPhe8NX4mxs2pV3XCvcqt0jUYKe
117U9Zs34puBUJkcvY2GtG3PT6HkC2W58QuXkYZunByus2xGGoBw2i7QQhT3ftZU
q3/VI3lMrUhYjkWA/LsG1sTnL/Qjc5ucG94CjSTB2mH9nwb/AN8PS4C3nLI077+G
QhN2uRnHLAtPm1opOzFvjgl74jgEDA==
=GcAL
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 25 Feb 2020 11:11
Re: [PATCH v2 1/2] build-system/linux-module: Disable depmod.
(name . Ludovic Courtès)(address . ludo@gnu.org)
20200225111148.485e6c38@scratchpost.org
Hi,

Toggle quote (2 lines)
> [comment] Otherwise LGTM.

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

Thanks for the review!
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5U8uQACgkQ5xo1VCww
uqUZtggAnlKqVPNKD1DgYEDYeN2M1JI7lamINIpDCe9G15dVZQwQf5illEdwBUZm
XmclrJTJmMWsQW7pagmmrPz2bKrDUjyIYLggMclQAmICZpxITmJXC1j4kp+hqEej
4wQJGLYI0gQeVMWfXq3dgryza5SxD/ESuitq+KvBlRDGWeojdqvFvEO7ABVbBqSs
KI8MvQWC41vGa9aGa+PPndxzSjn0dyaE4ACFiEgpHQCiMWtOw55Wo1yqqxmWtnIh
l1cX9aDrt+6oF1rxmSc2KfQlawGH14d6VA7NCk4ewXU2OF5cX1fS2hgifLJku0ZR
xYi+XR9DG58/KAATbzSTKw5fazWAfg==
=2b6u
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 25 Feb 2020 11:21
[PATCH v3] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200225102154.29415-1-dannym@scratchpost.org
* 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

Toggle diff (334 lines)
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
D
D
Danny Milosavljevic wrote on 25 Feb 2020 11:55
[PATCH v4] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200225105549.30115-1-dannym@scratchpost.org
* 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

Toggle diff (327 lines)
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
D
D
Danny Milosavljevic wrote on 25 Feb 2020 12:32
20200225123245.724af21e@scratchpost.org
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?
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5VBd0ACgkQ5xo1VCww
uqVUAwf+NPUCOu7M5UWsbWlGYLoVojKbCORqfO5MP5qUF4JOf2Jyap5YorcbMlV4
KlW9W7qn9K6LB4sXtrWSB/t82kr0LtzRHBElwymeZNopEICPqH86gBFFbAgptPcB
7qZUzaWFVocWM8YaI+uM8Qhta/f3YrJVzWTl14ZExbLNpRBcNGlU4k5sys+ypXki
0p03Je0oUk7LBudvYnhG6h8mCDZScaXEYXGy494NRKN4iWs+qfRbxEjnvuavvJ/3
Vz50+fsRJsWpOTnQ31HOr0ktiMYJM+rfvxzltJJS5894QVvjq39HwJlW/QYZ/Lwq
jQaOd0KWgSs3q6oJnyLlBP8detcB4Q==
=YwKJ
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 25 Feb 2020 14:34
20200225143435.756a5ed3@scratchpost.org
Toggle quote (4 lines)
> 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.

Toggle diff (21 lines)
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")
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5VImsACgkQ5xo1VCww
uqUjQwf/csGxZg4o1PfW3wHH2gaIZ5TpZVQLEMnWIHkxPAeOskO6Z3qXVl9HYNt8
4My0oTFdaXjbkUkSQYjNzkfakiV5PPq3z4VLWS/TSRC05xoVJ94UWtfFZvl2ZxYK
Ttp9en6JLryd9kz/znAjZO4rW99PI7FUxXqNtTNuadYGik3kFYvU//4mlYTnZlZK
ypH3cTZ8OrUY7+UCJG1rpgnnm1kHp1+ixUB9dRjOZxIoBF594IJGujA+UvoGXu5b
zbRIc39h89ibQtE1QBJr/F/1mHVCnHSnPQ3C+uZGV6oNTsnJkIYvzSGDWWNa4Jy7
f2yXvW/LwawXYeSC/hOnAmKUTED4Zw==
=Fbza
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 26 Feb 2020 20:59
[PATCH v5] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200226195929.3615-1-dannym@scratchpost.org
* 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

Toggle diff (377 lines)
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
D
D
Danny Milosavljevic wrote on 27 Feb 2020 12:15
20200227121529.70af6d24@scratchpost.org
Toggle quote (2 lines)
> + ;; 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)
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5XpNEACgkQ5xo1VCww
uqXu/QgAgFyCIxUKnG+rpgK7SAk6bMnn0eVbALn2gEizKyX/h/YYhAW4tETJ3GTZ
Y4i6gbk+KVwkrhEbNDBuDA1QFbB2IXIA7DQFNJvOZ1vOGtlznn+7NVY8RRhTmfug
DkVA3DdkZ69LXtlH1hEUZVCRR8voPgaXgqFBicE2wMriVTr0aXzB79giZS45axKk
N3E1eyEslyqWItvH7XNO7MhW51CgiTuUqKcRUPVua62k79UCzNYa/JGEx/FprZOv
fUo19pKJb2AfGA07euKARaRo/qG0+CTQFSkFs8++AbDs1YroRU0hCTJM4m0IGoe6
wJoIxcJxFgjW1qcHMySc6BtJQKi6DA==
=n8X8
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 27 Feb 2020 13:25
[PATCH v6] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200227122519.3226-1-dannym@scratchpost.org
* 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

Toggle diff (370 lines)
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
D
D
Danny Milosavljevic wrote on 27 Feb 2020 14:51
[PATCH v7] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200227135146.5701-1-dannym@scratchpost.org
* 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

Toggle diff (370 lines)
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
D
D
Danny Milosavljevic wrote on 27 Feb 2020 16:50
[PATCH v8] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200227155029.2542-1-dannym@scratchpost.org
* 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

Toggle diff (362 lines)
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
D
D
Danny Milosavljevic wrote on 14 Mar 2020 19:40
(address . 37868@debbugs.gnu.org)
20200314194055.6d857037@scratchpost.org
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.

-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5tJTcACgkQ5xo1VCww
uqWS7Qf8CFJf3ZADwZD1RnVMVANWMAj7m6ffpB7pdcj9v4hhu9LTsZ8/JWCwX6XU
Cvs6uqeZsVWrsrsecTZxS5gM79+ijvay7xwPAqb+p9Slvq3tJEYIatis/5SwCd6Z
Wzgv2P9yQRQ2Z180Vjksa0yQDOQGtmao6b8QOkvRVNGGTzZPDX+xsKDYZqFsKrsp
yN9KKsRy96W5wdA8x9ov9K4XJj3vhFsj7qm0mnl7eUxHv+UhVRlL7oDRdUPQ9l9Q
93PZF4dinfwYp4S8NW1G+nNwws2jlWeqj2OSIUc/nvMHLUTN7z8OX5ZCN0U8uSWw
Kw7pdhXE/Jad3lFBjz5UocA0CVIBdw==
=16bD
-----END PGP SIGNATURE-----


M
M
Mathieu Othacehe wrote on 15 Mar 2020 11:28
Re: [bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.
(address . guix-patches@gnu.org)
877dzlgbe2.fsf@gmail.com
Hello Danny,

Toggle quote (3 lines)
> 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.

Toggle quote (5 lines)
> 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.

Toggle quote (6 lines)
> 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
M
M
Mathieu Othacehe wrote on 15 Mar 2020 11:33
(address . guix-patches@gnu.org)
875zf5gb5m.fsf@gmail.com
Toggle quote (3 lines)
> Regarding --system, producing disk-images is currently broken on all
> branches[1], so it will be harder to test it for now.

D
D
Danny Milosavljevic wrote on 15 Mar 2020 19:17
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)
20200315191736.33ed8abf@scratchpost.org
Hi Mathieu,

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

Toggle quote (3 lines)
> Yes, "profile-derivation" should use the current system or target if the
> #:system and #:target arguments are #f.

OK!

Toggle quote (6 lines)
> 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.

Toggle quote (3 lines)
> 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"...

Toggle quote (10 lines)
>
> + (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).

Toggle quote (2 lines)
> As stated above, I think you are fine removing the TODO.

Cool!
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5ucUAACgkQ5xo1VCww
uqVidgf/a/Q3RJEAZUsFuElmRQuRshz2+gw2JNAwemJKhLQasWPqsDErIqrNfAhU
mdrAGGEI3LaFwuPldrgAxZKBTIKCunjmZcgX9s8GqFds2ayQOSPhkqKrLg+vTt8G
QXGtWuZuLXY3KPGfb/wXGFy0K3EGvOfRnFC6b29XB8rVb+wFpZ2X9wz6TOpGUZBz
c8oaTqq7BulOgoyu+tJTSGGLcju99rlSTYDiVbd+wluUV+P8O5CLn3uxNw521Slg
QrbZYmMqr1r6QjdDzGblr+Yub36VN8tSNA13meyu3AJenmoAvFiOaMn/Z6G7SnAm
22QPMZ89z27DCHdSbT73L9gTqtR1iA==
=9DR3
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 15 Mar 2020 22:00
Re: [PATCH v6] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
877dzlibaj.fsf@gnu.org
Hi!

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (11 lines)
> * 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.

[...]

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

Perhaps you can add an example.

Toggle quote (8 lines)
> +(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)

Toggle quote (2 lines)
> +(define (depmod! kmod inputs version destination-directory output)

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

Toggle quote (11 lines)
> + (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.

Toggle quote (5 lines)
> +(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?

Toggle quote (17 lines)
> (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.

Toggle quote (2 lines)
> +++ b/gnu/tests/linux-modules.scm

Nice!

Toggle quote (11 lines)
> +;; 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. :-)

Toggle quote (4 lines)
> +(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.

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

80 chars please. :-)

Toggle quote (7 lines)
> + #~(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.

Toggle quote (7 lines)
> + (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.

Toggle quote (11 lines)
> + ;; 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’.
L
L
Ludovic Courtès wrote on 15 Mar 2020 22:02
Re: [PATCH v8] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
8736a9ib62.fsf@gnu.org
Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (14 lines)
> 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’.
D
D
Danny Milosavljevic wrote on 15 Mar 2020 23:09
Re: [PATCH v6] system: Add kernel-module-packages to operating-system.
(name . Ludovic Courtès)(address . ludo@gnu.org)
20200315224832.5f2e336c@scratchpost.org
Hi Ludo,

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

Toggle quote (3 lines)
> 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.

Toggle quote (10 lines)
> > + (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)
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5up4AACgkQ5xo1VCww
uqXoSwf/XSlyTXoS5uD8S9OQwdr8Q0jN9HI6ZX18Buw3mn9ZY6c5rxlIthCvgUaJ
eEmd7KONWBHpNzwqLi8miBSkfYziDyv80BHt8qJuiY9sLK4xPl810XL0eMqB5QN2
U1Mpsj8IiIyZ2DzuZKV4FB3Wh+z7f+yWdjpBrbqWVZty9UpQrDrE2rA8JyRgGAxY
HShfTtduD82zm6nZg/ChOGe2mixe/eeqcF6cvRDv/o8f5Hzfw2QRpA1TZT3PyZBo
Ceejq1UFj7rQ0o7BubcIsrcHMrEbV8y5nMOczB4lf4UaV0wHYJVBmcf4EH99j/YC
FYjN3fZN4HhGYnvIOayf6KBmwa7gtg==
=Lrsc
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 16 Mar 2020 09:55
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
874kuofzlk.fsf@gnu.org
Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (13 lines)
> 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.

Toggle quote (2 lines)
> That said, I can do it--but it would increase build dependencies.

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

Toggle quote (20 lines)
>> > + (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.

Toggle quote (8 lines)
> 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.)

Toggle quote (5 lines)
> (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’.
M
M
Mathieu Othacehe wrote on 16 Mar 2020 10:55
Re: [bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87y2s0ei8i.fsf@gmail.com
Hello Danny,

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

Toggle snippet (3 lines)
(kernel-loadable-modules (list acpi-call-linux-module))

However, I have the following error:

Toggle snippet (3 lines)
guix system: error: gnu/packages/linux.scm:886:2: acpi-call-linux-module@3.17: build system `linux-module' does not support cross builds

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

Thanks,

Mathieu
D
D
Danny Milosavljevic wrote on 16 Mar 2020 21:04
Re: [PATCH v6] system: Add kernel-module-packages to operating-system.
(name . Mark H Weaver)(address . mhw@netris.org)
20200316210425.5a90e0cc@scratchpost.org
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?
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5v28kACgkQ5xo1VCww
uqUy9ggAiUEUSS0wD21ybvErqI3X1qb0oZiYaa/KYbTSsIfykA7Vx2OtbblJ3Aut
+uJmXvgwI8hNpE27BgLw1Cx7uov4yoofdvP1G9LaX6sVkvl3oow8RupM/Q94pLr3
lJg8rwBWMX8h4yunux5Rm27uVu88RwgAM0lVoMMf0FBLdluR09Fc0x9o6DJN9RbI
hRk3ILCWoa14tnf4fXGUQzAEnLYJYToaJ2PSEXTX1HOpFJ0mC68OfGnFQd2xfNVF
g5Uy9Yywv6R9NBqj+iEzz7nV/+RFOfBUlbCShm6Dgpcc4oTxsVKZ2xvRNx19x0uX
V8iF7LeJKv4F+PIIbiZHn5LJxg7a5A==
=Qbgy
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 16 Mar 2020 21:10
Re: [bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)
20200316211052.5d4e29a2@scratchpost.org
Hi Mathieu,

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

Toggle quote (6 lines)
> --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.
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5v3UwACgkQ5xo1VCww
uqV9GQf+N58I5b+hb5DL1S8Oy93BCCXP+CV2yyqb4MHeXi75Y85UnxYb30f9DXg1
rDl3mCnvel/PVtp0TJSFrvdmq4KhgOEeQr20iNUyjk6HpC4v0K8r3sCLhJ82/VZ0
41oUJ4Y7vVYMThFlONnV6GlvcdyqJ4GX/tZktcelVzdMeUlcJqpvNCKCC1ksTDYo
avB2lu9mXMcC9HFRefbtFa1oWJ439vu/mrKMVn1jJo9hfAKkbDDTBXRQ7U5ocbRR
BF+FNweu4V4VeJx2XRj/A4SHZfex2P8JQzuBr4XU7/qID3QqNdt16/aRUoKejjF2
KWIXX9oDMC+q4ZI/TvMlDg/lDfQg6g==
=ccxM
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 16 Mar 2020 21:17
[PATCH v9] system: Add kernel-loadable-modules to operating-system.
(address . 37868@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200316201719.11392-1-dannym@scratchpost.org
* 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

Toggle diff (368 lines)
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
D
D
Danny Milosavljevic wrote on 16 Mar 2020 21:31
Re: [PATCH v6] system: Add kernel-module-packages to operating-system.
(name . Ludovic Courtès)(address . ludo@gnu.org)
20200316213112.39b97c4e@scratchpost.org
Hi Ludo,

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

Toggle quote (6 lines)
> > + (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?
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5v4hAACgkQ5xo1VCww
uqUGYAf/c2W17VVCNlZO3h4vtRkfW/eXJZFz+Y0clUAf+b9xi0juiBDULzEAZWqN
CMwdJ4KYoALNNYUuTvdALSCW8eR/U8FoQ/gA330b6zWmJA7snjVA4B2nNC9clD+F
fPbhLFUe5ink2IBVR/wQAKlP9aJ5rU6vuZg5TVNBePUdr2VGrQ2S5db+2NhMoMi1
3CBJ4hpMbGg8i/YW+2KJmz1Mf9klF4rhki+BLUllN0rBp6Jt9993qKq4ijfNpHN3
SE4Yv8pb24blEVNXTL7nZqTuroUL3OPb4VL9hd0XywXO/jKssc+zv+TO7Hfj6t8V
+k2TFfhrCnFQMtRyAah2gy4lJDjezQ==
=CwgN
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 17 Mar 2020 10:20
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
871rpre3ro.fsf@gnu.org
Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (11 lines)
> 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’.
L
L
Ludovic Courtès wrote on 17 Mar 2020 10:29
Re: [bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87v9n3cot7.fsf@gnu.org
Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (18 lines)
> 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’.
M
M
Mathieu Othacehe wrote on 18 Mar 2020 15:50
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87v9n1d8ez.fsf@gmail.com
Hello Danny,

Toggle quote (7 lines)
> 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:

Toggle snippet (3 lines)
guix build --target=aarch64-linux-gnu acpi-call-linux-module

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

Toggle snippet (4 lines)
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

Thanks,

Mathieu
D
D
Danny Milosavljevic wrote on 18 Mar 2020 17:06
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)
20200318170602.590139aa@scratchpost.org
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")))

?
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5yRu8ACgkQ5xo1VCww
uqWfWAf+Ls3ZskhFH/HmbvZd+ZSore0qrTWJpXLanfuLs6MXRxBZzm/hEDftoPok
7LgFaY38yl+WsQc4QlLIErRnP7tTtN8dVGipwplxmFZ4AlNAaJ3BDogxaUxfI7DS
Ez84X9/xfmldy8GdL5mx1HKBf9pwCw8cPbiavMfNSlqBmvDqV3N5O9gDMEKLpEQG
lbQaOOirX6iGQNeAkC5MLjBZXbIZp6o9nOuD4HVI7v6v/PyOBL6CAVcaBZkHFy9G
XI051i9RuH3sCePGNb0gcpgWyP6HkInFAtOm6xUmh9LpM0L7JS7J8rbCIakjRUHH
6PMOdk5SlbzE9jdEpPr98n34p8fm0A==
=FsVv
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 18 Mar 2020 18:00
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)
20200318180011.48de079f@scratchpost.org
Ohhhh, try adding (target target) to the bag in guix/build-system/linux-module.scm
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl5yU5sACgkQ5xo1VCww
uqX7Awf/advBVb0n56lKPHBtFy6lxySxqpTFjm23MdJI/DVhywuNO1+FzBvzvREH
l6m3YZ70ETO6bGga3plBpXdwAM/5OgGaxLY0UbqlYyqzSDEeSjLJ4WDmiM6bhHFJ
6XFA+E8npwWC3QEcnXIuLnLh9AeHZ+z1lnf7tUMqefXvR93rZFfT7gi5sTfxy7I0
TwdykthaZNopvRXzzaxFq1ZvV5AcN3SPfhTTanUlqdtSQOrlGWEGH0voHd2y8pSa
CNlZFYQ53W9UOLD50VYJ8u5ytiLMCMYt2ubpH6qIx6pzjkl/qMh00UNUmVmRNP85
I5bYpeTFbWc6NPxZBXc2kp2bNrnsrA==
=fxXA
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 18 Mar 2020 18:35
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)
87d0997eh1.fsf@gnu.org
Hey!

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

Toggle quote (9 lines)
>> 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’.
D
D
Danny Milosavljevic wrote on 19 Mar 2020 15:22
[PATCH v10] system: Add kernel-loadable-modules to operating-system.
(address . 37868@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20200319142219.2618-1-dannym@scratchpost.org
* 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

Toggle diff (369 lines)
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
D
D
Danny Milosavljevic wrote on 20 Mar 2020 11:19
Re: [bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)
20200320111938.4472f145@scratchpost.org
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.
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl50mLoACgkQ5xo1VCww
uqWpWwf+LCwOohJVmcQHhAf8h0+kMDwPMGjQfGrIOBkupbWPKmbysXMIu7kyzGJr
d9mceBuRWDg908kszQoiYpkIBFFeg/CTnwepf4qbY1utBPRz/BXha41hMO8bR/EP
Mtj+ytt6Z++3lPnvLUHpZJExHfv2A1+JTVxsFg+5u62tV7XX4Ooe3NZ0zM0oS9ql
dcPsBYmjZJCDcyuIU0tCi/pW5zHNDpwL77pZsSl35ut5mNxLMuegk5FKLogb1wQ9
p+DJLRMc+g5S6uaD71ebe3MgYa9Pr7FAEdiuz7xQDgb54m2gdLeq6DwITmCbPEI+
RnhfcaN7HYjMaaQ6bq0a9X6o7kOoMQ==
=45UY
-----END PGP SIGNATURE-----


M
M
Mathieu Othacehe wrote on 20 Mar 2020 11:32
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87lfnvjozd.fsf@gmail.com
Hello Danny,

Toggle quote (5 lines)
> 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
M
M
Mathieu Othacehe wrote on 20 Mar 2020 16:13
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
87fte3jbzj.fsf@gmail.com
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
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(-)

Toggle diff (254 lines)
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
M
M
Mathieu Othacehe wrote on 20 Mar 2020 18:52
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
CANVeeZzSjpWqGqESZS6tMReBA1EtRJtmTZ-Nz8xytN7L-7u=Hw@mail.gmail.com
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 :
Toggle quote (14 lines)
>
>
> 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
D
D
Danny Milosavljevic wrote on 21 Mar 2020 11:06
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)
20200321110602.7efdb7e0@scratchpost.org
Hi Mathieu,

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

Toggle quote (3 lines)
> 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!
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl515yMACgkQ5xo1VCww
uqVyzgf8DywugtNJ953q6xGV7a/EEps66xaEzTxrw4RSZDn/knW3Bc/5nJwj0J5u
aPsTPdErlexmoQPWVTOWiZbZ9ZIgGxtF2conv/pLyQeM9Xb2QXCVs1OIYh2RtXac
9oX1JL1K5n2SxixX5LHx1wJGpWbuLxJeZQkwbT1+sEzJhWYd5rdVujwdS8kn25Hv
az7xlgAG5uQ7B0PAvQ+Rof2i6Ek0j9/9NH1mNi7QwZ17uQn/P+HFyX6Krq3Ad72l
oK+GgwRUPtJ8Dm+cY5ZuB5YJ2UiO0CXCF1vbZ/BBTNvJHjWCrfQQ54cTfosPJAqN
RK3E+7njDg+U+mTg+a/4U40z4R1PQA==
=1Z6R
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 22 Mar 2020 13:01
Re: [PATCH v10] system: Add kernel-loadable-modules to operating-system.
(address . 37868-done@debbugs.gnu.org)
20200322130127.2abc0497@scratchpost.org
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.
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl53U5cACgkQ5xo1VCww
uqVHkAf/VkdNXMfC9QNwJ5WtM3UzbMHPXucGkSLDJDFmyrm5vnjOFJZDfMA6KAb3
4ubkZ2/QmiNMoIwsiIxuVBao9haVNGO3OOceXRLSyrtAMldBvWZ84FdDs29uDokr
y80FkFNu3Cqj1Q64t+5ZI4ZJ3TJOGc8C+bRa34IhvbIy5rscySvRWvZT+xlCapQp
zmgHaCFN9P+bRM0P6DZYfHmSVmr1sP8VpxgpeKp6bbnIrcoSsYtA8iFJLVhg4T0R
kfZ0HmAViPtruXNbsb8cFpGG9yzvHusi433ill120cvWdzpfaMkWdRRSktDlG+pM
tFtlq6xYNFbvBqDJ7lw5PToCzZ+cUA==
=X+TM
-----END PGP SIGNATURE-----


Closed
D
D
Danny Milosavljevic wrote on 22 Mar 2020 14:36
Re: [bug#37868] [PATCH v8] system: Add kernel-module-packages to operating-system.
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)
20200322143617.7b57d08f@scratchpost.org
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!
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl53adEACgkQ5xo1VCww
uqVfAgf+OWQGcXYuYc6VRmCg3eBVyqyIfgDi1aHcpNpSqb1zdlHo1pIigz8Zg//C
zhUvN+RktfnDpJCOg2Do3uNDbR2/+jGjz84uozRNAeYjDvxc2u+1DVmKzSTesBCS
QBPkGVLCQ/m3/pdRXTyr6XEw/YxToo0cw7SyoAx7fMJtBKx+xUK5OFBx1fGuYZML
A/KqsI4jKwSGP26FrcpqBjnZ+OZFejC6fFpyWfQHDij3p0mNaysRQZ6T6yFL/yr4
MFZRjyhZx8g1GT1FHYHxWAHk7fb4Tx68/1UQkuSxl5tQpGSk0c3DW4ufPaiDLDIF
Ob/TK2mI7ZiJeUsKVCr9IkQ58WZ/lA==
=nCOa
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 22 Mar 2020 22:11
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
871rpkt7qg.fsf@gnu.org
Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (5 lines)
> 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’.
?
Your comment

This issue is archived.

To comment on this conversation send email to 37868@debbugs.gnu.org