From unknown Fri Aug 15 21:25:18 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#30638] [WIP v2] linux-initrd: Make modprobe pure-Guile. Resent-From: Danny Milosavljevic Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 27 Feb 2018 22:14:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 30638 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 30638@debbugs.gnu.org, ludo@gnu.org Cc: Danny Milosavljevic X-Debbugs-Original-To: guix-patches@gnu.org, ludo@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.151976962215318 (code B ref -1); Tue, 27 Feb 2018 22:14:02 +0000 Received: (at submit) by debbugs.gnu.org; 27 Feb 2018 22:13:42 +0000 Received: from localhost ([127.0.0.1]:36100 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eqnVG-0003z0-EJ for submit@debbugs.gnu.org; Tue, 27 Feb 2018 17:13:42 -0500 Received: from eggs.gnu.org ([208.118.235.92]:52619) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eqnVE-0003yo-VO for submit@debbugs.gnu.org; Tue, 27 Feb 2018 17:13:41 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eqnV8-0003Er-Ea for submit@debbugs.gnu.org; Tue, 27 Feb 2018 17:13:35 -0500 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-0.0 required=5.0 tests=BAYES_40 autolearn=disabled version=3.3.2 Received: from lists.gnu.org ([2001:4830:134:3::11]:55666) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1eqnV8-0003Eh-BV for submit@debbugs.gnu.org; Tue, 27 Feb 2018 17:13:34 -0500 Received: from eggs.gnu.org ([2001:4830:134:3::10]:43578) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eqnV6-0003KJ-RI for guix-patches@gnu.org; Tue, 27 Feb 2018 17:13:34 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eqnV1-0003D2-RZ for guix-patches@gnu.org; Tue, 27 Feb 2018 17:13:32 -0500 Received: from dd26836.kasserver.com ([85.13.145.193]:50234) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1eqnV1-0003CX-GF; Tue, 27 Feb 2018 17:13:27 -0500 Received: from dayas.3.home (178.113.174.26.wireless.dyn.drei.com [178.113.174.26]) by dd26836.kasserver.com (Postfix) with ESMTPSA id CE510336009F; Tue, 27 Feb 2018 23:13:24 +0100 (CET) From: Danny Milosavljevic Date: Wed, 28 Feb 2018 00:13:26 +0100 Message-Id: <20180227231326.1645-1-dannym@scratchpost.org> X-Mailer: git-send-email 2.15.1 In-Reply-To: <20180227235027.00bc79b1@scratchpost.org> References: <20180227235027.00bc79b1@scratchpost.org> Tags: patch X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 2001:4830:134:3::11 X-Spam-Score: -5.0 (-----) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -5.0 (-----) * gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe. * gnu/system/linux-initrd.scm (%modprobe-exp): New variable. (expression->initrd): Delete parameter "kmod". Use the above. (raw-initrd): Replace kmod's default by "kmod". (base-initrd): Replace kmod's default by "kmod". Add LINUX-MODULES parameter again because it fell out before (?). --- gnu/build/linux-initrd.scm | 7 ++--- gnu/system/linux-initrd.scm | 65 ++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 63 insertions(+), 9 deletions(-) diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm index 6356007df..f54d7102d 100644 --- a/gnu/build/linux-initrd.scm +++ b/gnu/build/linux-initrd.scm @@ -107,7 +107,7 @@ This is similar to what 'compiled-file-name' in (system base compile) does." (define* (build-initrd output #:key - guile init kmod linux-module-directory + guile init modprobe linux-module-directory (references-graphs '()) (gzip "gzip")) "Write an initial RAM disk (initrd) to OUTPUT. The initrd starts the script @@ -132,9 +132,10 @@ REFERENCES-GRAPHS." (readlink "proc/self/exe") ;; Make modprobe available as /sbin/modprobe so the kernel finds it. - (when kmod + (when modprobe (mkdir-p "sbin") - (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe")) + (symlink modprobe "sbin/modprobe") + (compile-to-cache "sbin/modprobe")) ;; Make modules available as /lib/modules so modprobe finds them. (mkdir-p "lib") diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 1cb73b310..16b1383fa 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -56,12 +56,60 @@ ;;; ;;; Code: +(define* (%modprobe linux-module-directory #:key + (guile %guile-static-stripped)) + (program-file "modprobe" + (with-imported-modules (source-module-closure + '((gnu build linux-modules))) + #~(begin + (use-modules (gnu build linux-modules) (ice-9 getopt-long) + (ice-9 match) (srfi srfi-1) (ice-9 ftw)) + (define (find-only-entry directory) + (match (scandir directory) + (("." ".." basename) + (string-append directory "/" basename)))) + (define (lookup module) + (let* ((linux-release-module-directory + (find-only-entry (string-append "/lib/modules"))) + (file-name (string-append linux-release-module-directory + "/" (ensure-dot-ko module)))) + (if (file-exists? file-name) + file-name + ;; FIXME: Make safe. + (match (delete-duplicates (matching-modules module + (known-module-aliases + (string-append linux-release-module-directory + "/modules.alias")))) + (() + (error "no module by that name" module)) + ((x-name) (lookup x-name)) + ((_ ...) + (error "several modules by that name" + module)))))) + (define option-spec + '((quiet (single-char #\q) (value #f)))) + (define options + (getopt-long (command-line) option-spec)) + (when (option-ref options 'quiet #f) + (current-error-port (%make-void-port "w")) + (current-output-port (%make-void-port "w"))) + (for-each (match-lambda + (('quiet . #t) + #f) + ((() modules ...) + (for-each (lambda (module) + (let ((file-name (lookup module))) + (load-linux-module* file-name + #:lookup-module + lookup))) + modules))) + options))) + #:guile guile)) (define* (expression->initrd exp #:key (guile %guile-static-stripped) (gzip gzip) - kmod linux-module-directory (name "guile-initrd") (system (%current-system))) @@ -75,6 +123,9 @@ the derivations referenced by EXP are automatically copied to the initrd." (define init (program-file "init" exp #:guile guile)) + (define modprobe + (%modprobe linux-module-directory #:guile guile)) + (define builder (with-imported-modules (source-module-closure '((gnu build linux-initrd))) @@ -98,14 +149,16 @@ the derivations referenced by EXP are automatically copied to the initrd." (build-initrd (string-append #$output "/initrd") #:guile #$guile #:init #$init - #:kmod #$kmod + #:modprobe #$modprobe #:linux-module-directory #$linux-module-directory - ;; Copy everything INIT refers to into the initrd. - #:references-graphs '("closure") + ;; Copy everything INIT and MODPROBE refer to into the initrd. + #:references-graphs '("init-closure" + "modprobe-closure") #:gzip (string-append #$gzip "/bin/gzip"))))) (gexp->derivation name builder - #:references-graphs `(("closure" ,init)))) + #:references-graphs `(("init-closure" ,init) + ("modprobe-closure" ,modprobe)))) (define (flat-linux-module-directory linux modules kmod) "Return a flat directory containing the Linux kernel modules listed in @@ -247,7 +300,6 @@ upon error." #:qemu-guest-networking? #$qemu-networking? #:volatile-root? '#$volatile-root? #:on-error '#$on-error))) - #:kmod kmod #:linux-module-directory kodir #:name "raw-initrd")) @@ -321,6 +373,7 @@ FILE-SYSTEMS." (define* (base-initrd file-systems #:key (linux linux-libre) + (linux-modules '()) (kmod kmod-minimal/static) (mapped-devices '()) qemu-networking? From unknown Fri Aug 15 21:25:18 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#30638] [WIP v2] linux-initrd: Make modprobe pure-Guile. Resent-From: Danny Milosavljevic Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 27 Feb 2018 22:18:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 30638 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 30638@debbugs.gnu.org, ludo@gnu.org Received: via spool by 30638-submit@debbugs.gnu.org id=B30638.151976986515736 (code B ref 30638); Tue, 27 Feb 2018 22:18:01 +0000 Received: (at 30638) by debbugs.gnu.org; 27 Feb 2018 22:17:45 +0000 Received: from localhost ([127.0.0.1]:36106 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eqnZB-00045k-2p for submit@debbugs.gnu.org; Tue, 27 Feb 2018 17:17:45 -0500 Received: from dd26836.kasserver.com ([85.13.145.193]:40842) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eqnZ9-00045c-VY for 30638@debbugs.gnu.org; Tue, 27 Feb 2018 17:17:44 -0500 Received: from localhost (178.113.174.26.wireless.dyn.drei.com [178.113.174.26]) by dd26836.kasserver.com (Postfix) with ESMTPSA id 14D4C336009F; Tue, 27 Feb 2018 23:17:43 +0100 (CET) Date: Wed, 28 Feb 2018 00:17:48 +0100 From: Danny Milosavljevic Message-ID: <20180228001748.5891c7c1@scratchpost.org> In-Reply-To: <20180227231326.1645-1-dannym@scratchpost.org> References: <20180227235027.00bc79b1@scratchpost.org> <20180227231326.1645-1-dannym@scratchpost.org> X-Mailer: Claws Mail 3.16.0 (GTK+ 2.24.31; x86_64-unknown-linux-gnu) MIME-Version: 1.0 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.7 (/) > + (current-error-port (%make-void-port "w")) > + (current-output-port (%make-void-port "w"))) Note: For some reason this doesn't suppress (error ...) messages. From unknown Fri Aug 15 21:25:18 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#30638] [WIP v3] linux-initrd: Make modprobe pure-Guile. Resent-From: Danny Milosavljevic Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 28 Feb 2018 10:48:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 30638 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 30638@debbugs.gnu.org, ludo@gnu.org Cc: Danny Milosavljevic Received: via spool by 30638-submit@debbugs.gnu.org id=B30638.15198148781441 (code B ref 30638); Wed, 28 Feb 2018 10:48:01 +0000 Received: (at 30638) by debbugs.gnu.org; 28 Feb 2018 10:47:58 +0000 Received: from localhost ([127.0.0.1]:36474 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eqzHA-0000N9-H2 for submit@debbugs.gnu.org; Wed, 28 Feb 2018 05:47:56 -0500 Received: from dd26836.kasserver.com ([85.13.145.193]:42114) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eqzH8-0000Mz-0t for 30638@debbugs.gnu.org; Wed, 28 Feb 2018 05:47:54 -0500 Received: from dayas.3.home (178.113.190.242.wireless.dyn.drei.com [178.113.190.242]) by dd26836.kasserver.com (Postfix) with ESMTPSA id 931853362230; Wed, 28 Feb 2018 11:47:52 +0100 (CET) From: Danny Milosavljevic Date: Wed, 28 Feb 2018 12:47:52 +0100 Message-Id: <20180228114752.1361-1-dannym@scratchpost.org> X-Mailer: git-send-email 2.15.1 In-Reply-To: <20180227231326.1645-1-dannym@scratchpost.org> References: <20180227231326.1645-1-dannym@scratchpost.org> Tags: patch X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.7 (/) * gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe. * gnu/system/linux-initrd.scm (%modprobe-exp): New variable. (expression->initrd): Delete parameter "kmod". Use the above. (base-initrd): Add LINUX-MODULES parameter again because it fell out before (?) --- gnu/build/linux-initrd.scm | 7 +++-- gnu/system/linux-initrd.scm | 74 +++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 72 insertions(+), 9 deletions(-) diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm index 6356007df..f54d7102d 100644 --- a/gnu/build/linux-initrd.scm +++ b/gnu/build/linux-initrd.scm @@ -107,7 +107,7 @@ This is similar to what 'compiled-file-name' in (system base compile) does." (define* (build-initrd output #:key - guile init kmod linux-module-directory + guile init modprobe linux-module-directory (references-graphs '()) (gzip "gzip")) "Write an initial RAM disk (initrd) to OUTPUT. The initrd starts the script @@ -132,9 +132,10 @@ REFERENCES-GRAPHS." (readlink "proc/self/exe") ;; Make modprobe available as /sbin/modprobe so the kernel finds it. - (when kmod + (when modprobe (mkdir-p "sbin") - (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe")) + (symlink modprobe "sbin/modprobe") + (compile-to-cache "sbin/modprobe")) ;; Make modules available as /lib/modules so modprobe finds them. (mkdir-p "lib") diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 1cb73b310..0ae21882e 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -56,12 +56,69 @@ ;;; ;;; Code: +(define* (%modprobe linux-module-directory #:key + (guile %guile-static-stripped)) + (program-file "modprobe" + (with-imported-modules (source-module-closure + '((gnu build linux-modules))) + #~(begin + (use-modules (gnu build linux-modules) (ice-9 getopt-long) + (ice-9 match) (srfi srfi-1) (ice-9 ftw)) + (define (find-only-entry directory) + (match (scandir directory) + (("." ".." basename) + (string-append directory "/" basename)))) + (define (lookup module) + (let* ((linux-release-module-directory + (find-only-entry (string-append "/lib/modules"))) + (file-name (string-append linux-release-module-directory + "/" (ensure-dot-ko module)))) + (if (file-exists? file-name) + file-name + (match (delete-duplicates (matching-modules module + (known-module-aliases + (string-append linux-release-module-directory + "/modules.alias")))) + (() + (error "no module by that name" module)) + ((x-name) + (lookup x-name)) + ((_ ...) + (error "several modules by that name" + module)))))) + (define option-spec + '((quiet (single-char #\q) (value #f)))) + (define options + (getopt-long (command-line) option-spec)) + (when (option-ref options 'quiet #f) + (current-error-port (%make-void-port "w")) + (current-output-port (%make-void-port "w"))) + (let ((exit-status 0)) + (for-each (match-lambda + (('quiet . #t) + #f) + ((() modules ...) + (for-each (lambda (module) + (catch #t + (lambda () + (let ((file-name (lookup module))) + (load-linux-module* file-name + #:lookup-module + lookup))) + (lambda (key . args) + (display (cons* key args) + (current-error-port)) + (newline (current-error-port)) + (set! exit-status 1)))) + modules))) + options) + (exit exit-status)))) + #:guile guile)) (define* (expression->initrd exp #:key (guile %guile-static-stripped) (gzip gzip) - kmod linux-module-directory (name "guile-initrd") (system (%current-system))) @@ -75,6 +132,9 @@ the derivations referenced by EXP are automatically copied to the initrd." (define init (program-file "init" exp #:guile guile)) + (define modprobe + (%modprobe linux-module-directory #:guile guile)) + (define builder (with-imported-modules (source-module-closure '((gnu build linux-initrd))) @@ -98,14 +158,16 @@ the derivations referenced by EXP are automatically copied to the initrd." (build-initrd (string-append #$output "/initrd") #:guile #$guile #:init #$init - #:kmod #$kmod + #:modprobe #$modprobe #:linux-module-directory #$linux-module-directory - ;; Copy everything INIT refers to into the initrd. - #:references-graphs '("closure") + ;; Copy everything INIT and MODPROBE refer to into the initrd. + #:references-graphs '("init-closure" + "modprobe-closure") #:gzip (string-append #$gzip "/bin/gzip"))))) (gexp->derivation name builder - #:references-graphs `(("closure" ,init)))) + #:references-graphs `(("init-closure" ,init) + ("modprobe-closure" ,modprobe)))) (define (flat-linux-module-directory linux modules kmod) "Return a flat directory containing the Linux kernel modules listed in @@ -247,7 +309,6 @@ upon error." #:qemu-guest-networking? #$qemu-networking? #:volatile-root? '#$volatile-root? #:on-error '#$on-error))) - #:kmod kmod #:linux-module-directory kodir #:name "raw-initrd")) @@ -321,6 +382,7 @@ FILE-SYSTEMS." (define* (base-initrd file-systems #:key (linux linux-libre) + (linux-modules '()) (kmod kmod-minimal/static) (mapped-devices '()) qemu-networking? From unknown Fri Aug 15 21:25:18 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#30638] [WIP v4] linux-initrd: Make modprobe pure-Guile. Resent-From: Danny Milosavljevic Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 28 Feb 2018 11:06:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 30638 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 30638@debbugs.gnu.org Cc: Danny Milosavljevic Received: via spool by 30638-submit@debbugs.gnu.org id=B30638.15198159143066 (code B ref 30638); Wed, 28 Feb 2018 11:06:02 +0000 Received: (at 30638) by debbugs.gnu.org; 28 Feb 2018 11:05:14 +0000 Received: from localhost ([127.0.0.1]:36502 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eqzXu-0000nO-8e for submit@debbugs.gnu.org; Wed, 28 Feb 2018 06:05:14 -0500 Received: from dd26836.kasserver.com ([85.13.145.193]:43560) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eqzXs-0000nF-Jr for 30638@debbugs.gnu.org; Wed, 28 Feb 2018 06:05:13 -0500 Received: from dayas.3.home (178.113.190.242.wireless.dyn.drei.com [178.113.190.242]) by dd26836.kasserver.com (Postfix) with ESMTPSA id D507333603C4; Wed, 28 Feb 2018 12:05:10 +0100 (CET) From: Danny Milosavljevic Date: Wed, 28 Feb 2018 13:05:14 +0100 Message-Id: <20180228120514.1387-1-dannym@scratchpost.org> X-Mailer: git-send-email 2.15.1 In-Reply-To: <20180228114752.1361-1-dannym@scratchpost.org> References: <20180228114752.1361-1-dannym@scratchpost.org> Tags: patch X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.7 (/) * gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe. * gnu/system/linux-initrd.scm (%modprobe-exp): New variable. (expression->initrd): Delete parameter "kmod". Use the above. (base-initrd): Add LINUX-MODULES parameter again because it fell out before (?) --- gnu/build/linux-initrd.scm | 7 ++-- gnu/system/linux-initrd.scm | 78 +++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 76 insertions(+), 9 deletions(-) diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm index 6356007df..f54d7102d 100644 --- a/gnu/build/linux-initrd.scm +++ b/gnu/build/linux-initrd.scm @@ -107,7 +107,7 @@ This is similar to what 'compiled-file-name' in (system base compile) does." (define* (build-initrd output #:key - guile init kmod linux-module-directory + guile init modprobe linux-module-directory (references-graphs '()) (gzip "gzip")) "Write an initial RAM disk (initrd) to OUTPUT. The initrd starts the script @@ -132,9 +132,10 @@ REFERENCES-GRAPHS." (readlink "proc/self/exe") ;; Make modprobe available as /sbin/modprobe so the kernel finds it. - (when kmod + (when modprobe (mkdir-p "sbin") - (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe")) + (symlink modprobe "sbin/modprobe") + (compile-to-cache "sbin/modprobe")) ;; Make modules available as /lib/modules so modprobe finds them. (mkdir-p "lib") diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 1cb73b310..59db128a2 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -56,12 +56,73 @@ ;;; ;;; Code: +(define* (%modprobe linux-module-directory #:key + (guile %guile-static-stripped)) + (program-file "modprobe" + (with-imported-modules (source-module-closure + '((gnu build linux-modules))) + #~(begin + (use-modules (gnu build linux-modules) (ice-9 getopt-long) + (ice-9 match) (srfi srfi-1) (ice-9 ftw)) + (define (find-only-entry directory) + (match (scandir directory) + (("." ".." basename) + (string-append directory "/" basename)))) + (define (resolve-alias alias) + (let* ((linux-release-module-directory + (find-only-entry (string-append "/lib/modules")))) + (match (delete-duplicates (matching-modules alias + (known-module-aliases + (string-append linux-release-module-directory + "/modules.alias")))) + (() + (error "no alias by that name" alias)) + (items + items)))) + (define (lookup-module module) + (let* ((linux-release-module-directory + (find-only-entry (string-append "/lib/modules"))) + (file-name (string-append linux-release-module-directory + "/" (ensure-dot-ko module)))) + (if (file-exists? file-name) + file-name + (error "no module file found for module" module)))) + (define option-spec + '((quiet (single-char #\q) (value #f)))) + (define options + (getopt-long (command-line) option-spec)) + (when (option-ref options 'quiet #f) + (current-error-port (%make-void-port "w")) + (current-output-port (%make-void-port "w"))) + (let ((exit-status 0)) + (for-each (match-lambda + (('quiet . #t) + #f) + ((() modules ...) + (for-each (lambda (alias) + (catch #t + (lambda () + (let ((modules (resolve-alias alias))) + (for-each (lambda (module) + (load-linux-module* + (lookup-module module) + #:lookup-module + lookup-module)) + modules))) + (lambda (key . args) + (display (cons* key args) + (current-error-port)) + (newline (current-error-port)) + (set! exit-status 1)))) + modules))) + options) + (exit exit-status)))) + #:guile guile)) (define* (expression->initrd exp #:key (guile %guile-static-stripped) (gzip gzip) - kmod linux-module-directory (name "guile-initrd") (system (%current-system))) @@ -75,6 +136,9 @@ the derivations referenced by EXP are automatically copied to the initrd." (define init (program-file "init" exp #:guile guile)) + (define modprobe + (%modprobe linux-module-directory #:guile guile)) + (define builder (with-imported-modules (source-module-closure '((gnu build linux-initrd))) @@ -98,14 +162,16 @@ the derivations referenced by EXP are automatically copied to the initrd." (build-initrd (string-append #$output "/initrd") #:guile #$guile #:init #$init - #:kmod #$kmod + #:modprobe #$modprobe #:linux-module-directory #$linux-module-directory - ;; Copy everything INIT refers to into the initrd. - #:references-graphs '("closure") + ;; Copy everything INIT and MODPROBE refer to into the initrd. + #:references-graphs '("init-closure" + "modprobe-closure") #:gzip (string-append #$gzip "/bin/gzip"))))) (gexp->derivation name builder - #:references-graphs `(("closure" ,init)))) + #:references-graphs `(("init-closure" ,init) + ("modprobe-closure" ,modprobe)))) (define (flat-linux-module-directory linux modules kmod) "Return a flat directory containing the Linux kernel modules listed in @@ -247,7 +313,6 @@ upon error." #:qemu-guest-networking? #$qemu-networking? #:volatile-root? '#$volatile-root? #:on-error '#$on-error))) - #:kmod kmod #:linux-module-directory kodir #:name "raw-initrd")) @@ -321,6 +386,7 @@ FILE-SYSTEMS." (define* (base-initrd file-systems #:key (linux linux-libre) + (linux-modules '()) (kmod kmod-minimal/static) (mapped-devices '()) qemu-networking? From debbugs-submit-bounces@debbugs.gnu.org Sat Mar 03 06:53:09 2018 Received: (at control) by debbugs.gnu.org; 3 Mar 2018 11:53:09 +0000 Received: from localhost ([127.0.0.1]:41892 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1es5iv-00085E-L4 for submit@debbugs.gnu.org; Sat, 03 Mar 2018 06:53:09 -0500 Received: from dd26836.kasserver.com ([85.13.145.193]:34166) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1es5it-000856-PR for control@debbugs.gnu.org; Sat, 03 Mar 2018 06:53:08 -0500 Received: from localhost (77.118.252.91.wireless.dyn.drei.com [77.118.252.91]) by dd26836.kasserver.com (Postfix) with ESMTPSA id BC29E3362284 for ; Sat, 3 Mar 2018 12:53:05 +0100 (CET) Date: Sat, 3 Mar 2018 12:53:03 +0100 From: Danny Milosavljevic To: Message-ID: <20180303125303.7d3ea354@scratchpost.org> X-Mailer: Claws Mail 3.16.0 (GTK+ 2.24.31; x86_64-unknown-linux-gnu) MIME-Version: 1.0 Content-Type: multipart/signed; micalg=pgp-sha256; boundary="Sig_/3IsEH8nRhHoH7vn1byVpYbs"; protocol="application/pgp-signature" X-Spam-Score: 1.3 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: close 30638 [...] Content analysis details: (1.3 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.7 RCVD_IN_DNSWL_LOW RBL: Sender listed at http://www.dnswl.org/, low trust [85.13.145.193 listed in list.dnswl.org] 1.8 MISSING_SUBJECT Missing Subject: header 0.2 NO_SUBJECT Extra score for no subject 0.0 TVD_SPACE_RATIO No description available. X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 1.3 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: close 30638 [...] Content analysis details: (1.3 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.7 RCVD_IN_DNSWL_LOW RBL: Sender listed at http://www.dnswl.org/, low trust [85.13.145.193 listed in list.dnswl.org] 1.8 MISSING_SUBJECT Missing Subject: header 0.2 NO_SUBJECT Extra score for no subject 0.0 TVD_SPACE_RATIO No description available. --Sig_/3IsEH8nRhHoH7vn1byVpYbs Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable close 30638 --Sig_/3IsEH8nRhHoH7vn1byVpYbs Content-Type: application/pgp-signature Content-Description: OpenPGP digital signature -----BEGIN PGP SIGNATURE----- iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAlqajJ8ACgkQ5xo1VCww uqVLCQf/Uorjnh20VIBniaEe1neAbNunFru/XHwVRNusczGSOzSuxvjdoRpCtvWs 5m6fZkpMaoo6W9bmuwOQxxShLL59zgmC5k9GXuiZQq72I30DkON0lUSAtEFkKdeo iA203OtZU73vzjj4om1ConisrjppYzIyZ+9nNtW18cGlcD5rrp0M6q6Q7FRuDYYK +p4UkrXQkqedYFdCSQ8dfHLUwq57cqlOlXJM2oM1ueC0CxcQ2OOja8AavcMuGKUC M3iVKoB/amTNK8vmTc4TuFAbgtZkVXdDX53HOFqOYb/yOvHAuZzfXKNV++4AfFIK qJcT3k20cB3tra4oqDM9PkqquGkmvw== =bWDK -----END PGP SIGNATURE----- --Sig_/3IsEH8nRhHoH7vn1byVpYbs--