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) ; @@ -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 ;;; Copyright © 2017 Maxim Cournoyer ;;; Copyright © 2019 Kyle Meyer +;;; Copyright © 2019 Danny Milosavljevic ;;; Copyright © 2019 Mathieu Othacehe ;;; ;;; 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