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

[Danny Milosavljevic <dannym@scratchpost.org>]

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

Hi Ludo,

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

Because I get 

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

on

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


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

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

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