From: Danny Milosavljevic <dannym@scratchpost.org>
To: 30638@debbugs.gnu.org, ludo@gnu.org
Subject: [bug#30638] [WIP v3] linux-initrd: Make modprobe pure-Guile.
Date: Wed, 28 Feb 2018 12:47:52 +0100 [thread overview]
Message-ID: <20180228114752.1361-1-dannym@scratchpost.org> (raw)
In-Reply-To: <20180227231326.1645-1-dannym@scratchpost.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 | 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?
next prev parent reply other threads:[~2018-02-28 10:48 UTC|newest]
Thread overview: 43+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-02-27 14:17 [bug#30629] [PATCH 0/5] Detect missing modules in the initrd Ludovic Courtès
2018-02-27 14:22 ` Ludovic Courtès
2018-02-27 14:22 ` [bug#30629] [PATCH 1/5] Add (guix glob) Ludovic Courtès
2018-02-27 21:45 ` Marius Bakke
2018-02-28 11:25 ` Danny Milosavljevic
2018-03-01 9:57 ` Ludovic Courtès
2018-03-01 10:11 ` Danny Milosavljevic
2018-03-01 14:29 ` Danny Milosavljevic
2018-02-27 14:22 ` [bug#30629] [PATCH 2/5] linux-modules: Add 'device-module-aliases' and related procedures Ludovic Courtès
2018-02-27 19:33 ` Danny Milosavljevic
2018-02-27 20:55 ` Ludovic Courtès
2018-02-27 21:58 ` Danny Milosavljevic
2018-02-27 21:24 ` Ludovic Courtès
2018-02-27 14:22 ` [bug#30629] [PATCH 3/5] linux-initrd: Separate file system module logic Ludovic Courtès
2018-03-01 14:31 ` Danny Milosavljevic
2018-02-27 14:22 ` [bug#30629] [PATCH 4/5] system: Add 'initrd-modules' field Ludovic Courtès
2018-03-01 18:39 ` Danny Milosavljevic
2018-02-27 14:22 ` [bug#30629] [PATCH 5/5] guix system: Check for the lack of modules in the initrd Ludovic Courtès
2018-03-02 12:39 ` Danny Milosavljevic
2018-02-27 21:29 ` [bug#30629] [PATCH 0/5] Detect missing " Danny Milosavljevic
2018-02-27 21:15 ` Ludovic Courtès
2018-02-27 22:50 ` Danny Milosavljevic
2018-02-27 23:13 ` [bug#30638] [WIP v2] linux-initrd: Make modprobe pure-Guile Danny Milosavljevic
2018-02-27 23:17 ` Danny Milosavljevic
2018-02-28 11:47 ` Danny Milosavljevic [this message]
2018-02-28 12:05 ` [bug#30638] [WIP v4] " Danny Milosavljevic
2018-02-28 11:36 ` [bug#30629] [PATCH 0/5] Detect missing modules in the initrd Danny Milosavljevic
2018-03-01 10:05 ` Ludovic Courtès
2018-03-01 10:11 ` Danny Milosavljevic
2018-03-01 11:46 ` Danny Milosavljevic
2018-03-01 13:39 ` Ludovic Courtès
2018-03-01 13:54 ` Danny Milosavljevic
2018-03-02 12:56 ` bug#30629: " Ludovic Courtès
2018-03-02 17:50 ` [bug#30629] " Danny Milosavljevic
2018-03-02 18:16 ` Danny Milosavljevic
2018-03-03 8:42 ` Ludovic Courtès
2018-03-01 13:55 ` Danny Milosavljevic
2018-03-01 21:20 ` Ludovic Courtès
2018-03-02 11:42 ` Danny Milosavljevic
2018-02-28 3:03 ` [bug#30629] Device mapper modalias Danny Milosavljevic
2018-03-01 8:56 ` Danny Milosavljevic
2018-03-01 10:11 ` Ludovic Courtès
2018-03-07 18:56 ` Danny Milosavljevic
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20180228114752.1361-1-dannym@scratchpost.org \
--to=dannym@scratchpost.org \
--cc=30638@debbugs.gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.