From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id 6O2vBqHQAF9iRQAA0tVLHw (envelope-from ) for ; Sat, 04 Jul 2020 18:55:29 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id SKx8AqHQAF8ifgAAB5/wlQ (envelope-from ) for ; Sat, 04 Jul 2020 18:55:29 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id B265D940900 for ; Sat, 4 Jul 2020 18:55:28 +0000 (UTC) Received: from localhost ([::1]:48090 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jrnJv-0007Dd-MS for larch@yhetil.org; Sat, 04 Jul 2020 14:55:27 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43974) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jrnJZ-0006d4-9C for guix-patches@gnu.org; Sat, 04 Jul 2020 14:55:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:48095) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jrnJY-0006qc-V7 for guix-patches@gnu.org; Sat, 04 Jul 2020 14:55:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jrnJY-0005Hq-TQ for guix-patches@gnu.org; Sat, 04 Jul 2020 14:55:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42193] [WIP 6/6] WIP services: Add kernel-module-configuration service. Resent-From: Brice Waegeneire Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 04 Jul 2020 18:55:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42193 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 42193@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.159388888720253 (code B ref -1); Sat, 04 Jul 2020 18:55:04 +0000 Received: (at submit) by debbugs.gnu.org; 4 Jul 2020 18:54:47 +0000 Received: from localhost ([127.0.0.1]:59635 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jrnJH-0005Ga-5t for submit@debbugs.gnu.org; Sat, 04 Jul 2020 14:54:47 -0400 Received: from lists.gnu.org ([209.51.188.17]:45510) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jrnJD-0005Fn-Jm for submit@debbugs.gnu.org; Sat, 04 Jul 2020 14:54:44 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43936) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jrnJD-0006Tg-BI for guix-patches@gnu.org; Sat, 04 Jul 2020 14:54:43 -0400 Received: from relay7-d.mail.gandi.net ([217.70.183.200]:46061) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jrnJA-0006nj-Vn for guix-patches@gnu.org; Sat, 04 Jul 2020 14:54:43 -0400 X-Originating-IP: 176.181.186.101 Received: from localhost (i15-les02-ntr-176-181-186-101.sfr.lns.abo.bbox.fr [176.181.186.101]) (Authenticated sender: brice@waegenei.re) by relay7-d.mail.gandi.net (Postfix) with ESMTPSA id 955E020004 for ; Sat, 4 Jul 2020 18:54:39 +0000 (UTC) From: Brice Waegeneire Date: Sat, 4 Jul 2020 20:54:31 +0200 Message-Id: <20200704185431.13739-7-brice@waegenei.re> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200704185234.12571-1-brice@waegenei.re> References: <20200704185234.12571-1-brice@waegenei.re> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=217.70.183.200; envelope-from=brice@waegenei.re; helo=relay7-d.mail.gandi.net X-detected-operating-system: by eggs.gnu.org: First seen = 2020/07/04 14:54:37 X-ACL-Warn: Detected OS = Linux 3.11 and newer X-Spam_score_int: -35 X-Spam_score: -3.6 X-Spam_bar: --- X-Spam_report: (-3.6 / 5.0 requ) BAYES_00=-1.9, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H2=-1, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=_AUTOLEARN X-Spam_action: no action X-Spam-Score: -1.6 (-) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -2.6 (--) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: 3.99 X-TUID: ZV3Z6v6xRAPm --- gnu/services/linux.scm | 166 +++++++++++++++++++++++++++++++++++- gnu/tests/linux-modules.scm | 67 +++++++++------ 2 files changed, 208 insertions(+), 25 deletions(-) diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index 7ea30a1270..9773dd5072 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -45,7 +45,22 @@ kernel-module-loader-service-type - modprobe-service-type)) + modprobe-service-type + + kernel-module + kernel-module? + kernel-module-name + kernel-module-package + kernel-module-aliases + kernel-module-install + kernel-module-remove + kernel-module-pre-dependencies + kernel-module-post-dependencies + kernel-module-blacklist? + kernel-module-load? + kernel-module-is-builtin? + kernel-module->kernel-arguments + kernel-module-configuration-service-type)) ;;; @@ -151,6 +166,9 @@ representation." (rnrs io ports) ,@%default-modules)) (start + ;; TODO Verify that we are loading a loadable kernel and not a builtin + ;; one looking in + ;; /run/booted-system/kernel/lib/modules/5.4.39/modules.builtin #~(lambda _ (cond ((null? '#$kernel-modules) #t) @@ -227,3 +245,149 @@ files." modprobe-environment))) (compose concatenate) (extend append))) + + +;;; +;;; Kernel module configuration. +;;; + +;; NOTE Maybe have sperate records betwwen and +;; +(define-record-type* + kernel-module make-kernel-module + kernel-module? + (name kernel-module-name) ; string + ;; For out-of-tree modules + (package kernel-module-package + (default #f)) ; #f | + ;; NOTE Maybe use an alist instead + (options kernel-module-options + (default '())) ; list of strings + (aliases kernel-module-aliases + (default '())) ; list of strings + (install kernel-module-install + (default #f)) ; #f | string + (remove kernel-module-remove + (default #f)) ; #f | string + (pre-dependencies kernel-module-pre-dependencies + (default '())) ; list of strings + (post-dependencies kernel-module-post-dependencies + (default '())) ; list of strings + (blacklist? kernel-module-blacklist? + (default #f)) ; boolean + ;; NOTE Only possible if it's not built-in + ;; TODO maybe trow an error when it's set to true on a built-in module + (load? kernel-module-load? + (default #f))) ; boolean + +;; FIXME use 'modules.builtin' instead +(define (kernel-module-is-builtin? module) + (if (kernel-module-package module) #f + #t)) + +(define (kernel-module->kernel-arguments module) + "Return a list of kernel arguments for MODULE." + (match-record module + (name options blacklist?) + (filter (lambda (s) (not (string-null? s))) + (list (if blacklist? (string-append name ".blacklist=yes") "") + (if (null? options) "" + (map (lambda (option) + (string-append name "." option)) + options)))))) + +(define (kernel-module->config module) + "Return a config string for MODULE." + (match-record module + (name options aliases install remove pre-dependencies + post-dependencies blacklist?) + (string-concatenate + (list (if (null? options) "" + (format #f "options ~a~{ ~a~}\n" name options)) + (if blacklist? (format #f "blacklist ~a\n" name) + "") + (if (null? aliases) "" + (map (lambda (alias) + (format #f "alias ~a ~a\n" alias name)) + aliases)) + (if install (format #f "install ~a ~a\n" name install) + "") + (if remove (format #f "remove ~a ~a\n" name remove) + "") + (if (null? pre-dependencies) "" + (map (lambda (dependency) + (format #f "softdep ~a :pre ~a\n" + name dependency)) + pre-dependencies)) + (if (null? post-dependencies) "" + (map (lambda (dependency) + (format #f "softdep ~a :post ~a\n" + name dependency)) + post-dependencies)))))) + +(define (string-underscorize s) + "Replace '-' characters by '_' in string S." + (string-map (lambda (c) (if (char=? c #\-) #\_ c)) s)) + +(define (kernel-modules->config-files modules) + "Return a list of pairs of file name and gexp, to be used by 'file-union', +from MODULES." + (define (kernel-module->filename-gexp module) + (let ((config (kernel-module->config module)) + (name (kernel-module-name module))) + (if (string-null? config) #f + (list (string-append name ".conf") + (plain-file (string-append name ".conf") config))))) + (filter-map + (lambda (module) + (let ((module (kernel-module + (inherit module) + ;; XXX The kernel replace '-' by '_' in module name, we do + ;; the same to make name collision visible, that would + ;; otherwise be hidden. + (name (string-underscorize (kernel-module-name module)))))) + (if (kernel-module-is-builtin? module) #f + (kernel-module->filename-gexp module)))) + modules)) + +(define (kernel-modules->packages modules) + "Return a list of packages from MODULES." + (filter-map (lambda (module) + (kernel-module-package module)) + modules)) + +(define (kernel-modules-to-load modules) + "Return a list of loadable module names, from MODULES, to be loaded." + (filter-map (lambda (module) + (if (and (not (kernel-module-is-builtin? module)) + (kernel-module-load? module)) + (kernel-module-name module) + #f)) + modules)) + +(define kernel-module-configuration-service-type + (service-type + (name 'kernel-module-configuration) + (description + "Configure kernel modules, in similar manner as @file{modprobe.d}.") + (default-value '()) + (extensions + (list (service-extension modprobe-service-type + kernel-modules->config-files) + (service-extension kernel-profile-service-type + kernel-modules->packages) + (service-extension kernel-module-loader-service-type + kernel-modules-to-load))) + (compose concatenate) + (extend append))) + +;; TODO Make a naked modprobe call use MODPROBE_OPTIONS environment or +;; /proc/sys/kernel/modprobe + +;; TODO write a helper to load a module from guile using modprobe command from +;; '/proc/sys/kernel/modprobe' or %modprobe-wrapper. See linux-module-builder +;; maybe. + +;; NOTE Throw an error when kernel-module-name isn't unique? It may already +;; do it by itself already because 2 loadable module will try to create +;; separeta config file with the same name. diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm index 22e9a0c65c..296066e68f 100644 --- a/gnu/tests/linux-modules.scm +++ b/gnu/tests/linux-modules.scm @@ -32,6 +32,7 @@ #:use-module (guix monads) #:use-module (guix store) #:use-module (guix utils) + #:use-module (srfi srfi-1) #:export (%test-loadable-kernel-modules-0 %test-loadable-kernel-modules-1 %test-loadable-kernel-modules-2)) @@ -66,19 +67,18 @@ that MODULES are actually loaded." (member module modules string=?)) '#$modules)))))) -(define* (run-loadable-kernel-modules-test module-packages module-names) - "Run a test of an OS having MODULE-PACKAGES, and verify that MODULE-NAMES -are loaded in memory." +(define* (run-loadable-kernel-modules-test modules) + "Run a test of an OS having MODULES and verify that they are loaded in +memory." (define os (marionette-operating-system (operating-system - (inherit (simple-operating-system)) - (services (cons* (service kernel-module-loader-service-type module-names) - (simple-service 'kernel-module-packages - kernel-profile-service-type - module-packages) - (operating-system-user-services - (simple-operating-system))))) + (inherit (simple-operating-system)) + (services (cons* (service kernel-module-loader-service-type) + (service kernel-module-configuration-service-type + modules) + (operating-system-user-services + (simple-operating-system))))) #:imported-modules '((guix combinators)))) (define vm (virtual-machine os)) (define (test script) @@ -97,15 +97,20 @@ are loaded in memory." marionette)) (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) - (gexp->derivation "loadable-kernel-modules" - (test (modules-loaded?-program os module-names)))) + (let ((modules (filter-map (lambda (module) + (if (kernel-module-load? module) + (kernel-module-name module) + #f)) + modules))) + (gexp->derivation "loadable-kernel-modules" + (test (modules-loaded?-program os modules))))) (define %test-loadable-kernel-modules-0 (system-test (name "loadable-kernel-modules-0") (description "Tests loadable kernel modules facility of with no extra modules.") - (value (run-loadable-kernel-modules-test '() '())))) + (value (run-loadable-kernel-modules-test '())))) (define %test-loadable-kernel-modules-1 (system-test @@ -113,8 +118,11 @@ with no extra modules.") (description "Tests loadable kernel modules facility of with one extra module.") (value (run-loadable-kernel-modules-test - (list ddcci-driver-linux) - '("ddcci"))))) + (list (kernel-module + (name "ddcci") + (package ddcci-driver-linux) + (options '("delay=606")) + (load? #t))))))) (define %test-loadable-kernel-modules-2 (system-test @@ -122,12 +130,23 @@ with one extra module.") (description "Tests loadable kernel modules facility of with two extra modules.") (value (run-loadable-kernel-modules-test - (list acpi-call-linux-module - (package - (inherit ddcci-driver-linux) - (arguments - `(#:linux #f - ,@(strip-keyword-arguments '(#:linux) - (package-arguments - ddcci-driver-linux)))))) - '("acpi_call" "ddcci"))))) + (list (kernel-module + (name "ddcci") + ;; XXX Verify that kernel modules are built with the correct + ;; kernel + (package (package + (inherit ddcci-driver-linux) + (arguments + `(#:linux #f + ,@(strip-keyword-arguments '(#:linux) + (package-arguments + ddcci-driver-linux)))))) + (load? #t)) + (kernel-module + (name "acpi_call") + (package acpi-call-linux-module) + (load? #t)) + ;; TODO Test that a module isn't loaded + (kernel-module + (name "radeon") + (blacklist? #t))))))) -- 2.26.2