unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile.
@ 2019-10-22 15:22 Danny Milosavljevic
  2019-11-12 16:20 ` Danny Milosavljevic
                   ` (2 more replies)
  0 siblings, 3 replies; 54+ messages in thread
From: Danny Milosavljevic @ 2019-10-22 15:22 UTC (permalink / raw)
  To: 37868; +Cc: Danny Milosavljevic

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

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

^ permalink raw reply related	[flat|nested] 54+ messages in thread

end of thread, other threads:[~2020-03-22 21:13 UTC | newest]

Thread overview: 54+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-10-22 15:22 [bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile Danny Milosavljevic
2019-11-12 16:20 ` Danny Milosavljevic
2019-11-12 17:47   ` Giovanni Biscuolo
2019-11-12 18:11   ` Giovanni Biscuolo
2019-11-13 13:30   ` Ludovic Courtès
2019-11-14 16:21     ` Danny Milosavljevic
2020-02-17 17:10     ` Danny Milosavljevic
2020-02-18  8:31       ` Ludovic Courtès
2019-11-14 17:48   ` Mark H Weaver
2020-02-18  9:42   ` [bug#37868] [PATCH v2 0/2] system: Add kernel-module-packages to operating-system and use it Danny Milosavljevic
2020-02-18  9:42     ` [bug#37868] [PATCH v2 1/2] build-system/linux-module: Disable depmod Danny Milosavljevic
2020-02-23 16:22       ` Ludovic Courtès
2020-02-25 10:11         ` Danny Milosavljevic
2020-02-18  9:42     ` [bug#37868] [PATCH v2 2/2] system: Add kernel-module-packages to operating-system Danny Milosavljevic
2020-02-18 12:31       ` Mathieu Othacehe
2020-02-23 16:36       ` Ludovic Courtès
2020-02-24 16:18         ` Danny Milosavljevic
2020-02-25 10:21     ` [bug#37868] [PATCH v3] " Danny Milosavljevic
2020-02-25 10:55     ` [bug#37868] [PATCH v4] " Danny Milosavljevic
2020-02-25 11:32       ` Danny Milosavljevic
2020-02-25 13:34         ` Danny Milosavljevic
2020-02-26 19:59       ` [bug#37868] [PATCH v5] " Danny Milosavljevic
2020-02-27 11:15         ` Danny Milosavljevic
2020-02-27 12:25         ` [bug#37868] [PATCH v6] " Danny Milosavljevic
2020-02-27 13:51           ` [bug#37868] [PATCH v7] " Danny Milosavljevic
2020-02-27 15:50             ` [bug#37868] [PATCH v8] " Danny Milosavljevic
2020-03-14 18:40               ` Danny Milosavljevic
2020-03-15 10:28                 ` Mathieu Othacehe
2020-03-15 10:33                   ` Mathieu Othacehe
2020-03-15 18:17                   ` Danny Milosavljevic
2020-03-16  9:55                     ` Mathieu Othacehe
2020-03-16 20:10                       ` Danny Milosavljevic
2020-03-17  9:29                         ` Ludovic Courtès
2020-03-18 14:50                         ` Mathieu Othacehe
2020-03-18 16:06                           ` Danny Milosavljevic
2020-03-18 17:00                             ` Danny Milosavljevic
2020-03-18 17:35                           ` Ludovic Courtès
2020-03-20 10:19                           ` Danny Milosavljevic
2020-03-20 10:32                             ` Mathieu Othacehe
2020-03-20 15:13                             ` Mathieu Othacehe
2020-03-20 17:52                               ` Mathieu Othacehe
2020-03-21 10:06                                 ` Danny Milosavljevic
2020-03-22 13:36                               ` Danny Milosavljevic
2020-03-22 21:11                                 ` Ludovic Courtès
2020-03-15 21:02                 ` Ludovic Courtès
2020-03-15 21:00           ` [bug#37868] [PATCH v6] " Ludovic Courtès
2020-03-15 22:09             ` Danny Milosavljevic
2020-03-16  8:55               ` Ludovic Courtès
2020-03-16 20:04                 ` Danny Milosavljevic
2020-03-16 20:31             ` Danny Milosavljevic
2020-03-17  9:20               ` Ludovic Courtès
2020-03-16 20:17 ` [bug#37868] [PATCH v9] system: Add kernel-loadable-modules " Danny Milosavljevic
2020-03-19 14:22 ` [bug#37868] [PATCH v10] " Danny Milosavljevic
2020-03-22 12:01   ` bug#37868: " Danny Milosavljevic

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).