[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#37868] [PATCH v2 2/2] system: Add kernel-module-packages to operati
|
From: |
Danny Milosavljevic |
|
Subject: |
[bug#37868] [PATCH v2 2/2] system: Add kernel-module-packages to operating-system. |
|
Date: |
Tue, 18 Feb 2020 10:42:07 +0100 |
* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(operating-system-directory-base-entries): Use it.
* guix/profiles.scm (linux-module-database): New procedure. Export it.
---
gnu/system.scm | 26 +++++++++++++---
guix/profiles.scm | 76 ++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 97 insertions(+), 5 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 01baa248a2..b1cd278044 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2016 Chris Marusich <address@hidden>
;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
;;; Copyright © 2019 Meiyo Peng <address@hidden>
+;;; Copyright © 2020 Danny Milosavljevic <address@hidden>
;;;
;;; 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 <address@hidden>
;;; Copyright © 2019 Kyle Meyer <address@hidden>
;;; Copyright © 2019 Mathieu Othacehe <address@hidden>
+;;; Copyright © 2020 Danny Milosavljevic <address@hidden>
;;;
;;; 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