Package: guix-patches;
Reported by: Danny Milosavljevic <dannym <at> scratchpost.org>
Date: Tue, 27 Feb 2018 22:14:02 UTC
Severity: normal
Done: Danny Milosavljevic <dannym <at> scratchpost.org>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 30638 in the body.
You can then email your comments to 30638 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#30638; Package guix-patches.
(Tue, 27 Feb 2018 22:14:02 GMT) Full text and rfc822 format available.Danny Milosavljevic <dannym <at> scratchpost.org>:guix-patches <at> gnu.org.
(Tue, 27 Feb 2018 22:14:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: guix-patches <at> gnu.org, ludo <at> gnu.org Cc: Danny Milosavljevic <dannym <at> scratchpost.org> Subject: [WIP v2] linux-initrd: Make modprobe pure-Guile. Date: Wed, 28 Feb 2018 00:13:26 +0100
* 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?
guix-patches <at> gnu.org:bug#30638; Package guix-patches.
(Tue, 27 Feb 2018 22:18:01 GMT) Full text and rfc822 format available.Message #8 received at 30638 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: 30638 <at> debbugs.gnu.org, ludo <at> gnu.org Subject: Re: [WIP v2] linux-initrd: Make modprobe pure-Guile. Date: Wed, 28 Feb 2018 00:17:48 +0100
> + (current-error-port (%make-void-port "w")) > + (current-output-port (%make-void-port "w"))) Note: For some reason this doesn't suppress (error ...) messages.
guix-patches <at> gnu.org:bug#30638; Package guix-patches.
(Wed, 28 Feb 2018 10:48:01 GMT) Full text and rfc822 format available.Message #11 received at 30638 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: 30638 <at> debbugs.gnu.org, ludo <at> gnu.org Cc: Danny Milosavljevic <dannym <at> scratchpost.org> Subject: [WIP v3] linux-initrd: Make modprobe pure-Guile. Date: Wed, 28 Feb 2018 12:47:52 +0100
* 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?
guix-patches <at> gnu.org:bug#30638; Package guix-patches.
(Wed, 28 Feb 2018 11:06:02 GMT) Full text and rfc822 format available.Message #14 received at 30638 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: 30638 <at> debbugs.gnu.org Cc: Danny Milosavljevic <dannym <at> scratchpost.org> Subject: [WIP v4] linux-initrd: Make modprobe pure-Guile. Date: Wed, 28 Feb 2018 13:05:14 +0100
* 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?
Danny Milosavljevic <dannym <at> scratchpost.org>
to control <at> debbugs.gnu.org.
(Sat, 03 Mar 2018 11:54:02 GMT) Full text and rfc822 format available.Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Sun, 01 Apr 2018 11:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.