From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:41037) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eqzYl-0006rg-9h for guix-patches@gnu.org; Wed, 28 Feb 2018 06:06:08 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eqzYh-0000oV-9G for guix-patches@gnu.org; Wed, 28 Feb 2018 06:06:07 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:56846) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eqzYh-0000oP-4j for guix-patches@gnu.org; Wed, 28 Feb 2018 06:06:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1eqzYg-0000p9-Sd for guix-patches@gnu.org; Wed, 28 Feb 2018 06:06:02 -0500 Subject: [bug#30638] [WIP v4] linux-initrd: Make modprobe pure-Guile. Resent-Message-ID: From: Danny Milosavljevic Date: Wed, 28 Feb 2018 13:05:14 +0100 Message-Id: <20180228120514.1387-1-dannym@scratchpost.org> In-Reply-To: <20180228114752.1361-1-dannym@scratchpost.org> References: <20180228114752.1361-1-dannym@scratchpost.org> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 30638@debbugs.gnu.org * 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?