[PATCH 0/4] Load Linux module only when supported hardware is present.

OpenSubmitted by Danny Milosavljevic.
Details
4 participants
  • Danny Milosavljevic
  • Ludovic Courtès
  • Mathieu Othacehe
  • Marius Bakke
Owner
unassigned
Severity
important
D
D
Danny Milosavljevic wrote on 25 Feb 2018 12:45
Download
(address . guix-patches@gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180225114557.816-1-dannym@scratchpost.org
Download
Danny Milosavljevic (4):
gnu: kmod: Split off kmod-minimal.
gnu: Add kmod-minimal-static.
linux-initrd: Add kmod.
linux-boot: Load kernel modules only when the hardware is present.

gnu/build/linux-boot.scm | 24 ++++++++++--
gnu/build/linux-initrd.scm | 13 ++++++-
gnu/packages/linux.scm | 91 +++++++++++++++++++++++++++++++++++++--------
gnu/system/linux-initrd.scm | 52 ++++++++++++++++++++------
4 files changed, 148 insertions(+), 32 deletions(-)
D
D
Danny Milosavljevic wrote on 25 Feb 2018 12:48
Download
[PATCH 1/4] gnu: kmod: Split off kmod-minimal.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180225114816.869-1-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal): New variable.
(kmod): Modify.
---
gnu/packages/linux.scm | 49 +++++++++++++++++++++++++++++++++----------------
1 file changed, 33 insertions(+), 16 deletions(-)

Toggle diff (81 lines)
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 238398e84..1f8bf3050 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1933,8 +1933,35 @@ for systems using the Linux kernel.  This includes commands such as
 to use Linux' inotify mechanism, which allows file accesses to be monitored.")
     (license license:gpl2+)))
 
-(define-public kmod
+(define kmod-minimal
   (package
+    (name "kmod-minimal")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f)) ; FIXME: Investigate test failures
+    (home-page "https://www.kernel.org/")
+    (synopsis "Kernel module tools")
+    (description "Kmod is a set of tools to handle common tasks with Linux
+kernel modules like insert, remove, list, check properties, resolve
+dependencies and aliases.
+
+These tools are designed on top of libkmod, a library that is shipped with
+kmod.  The aim is to be compatible with tools, configurations and indices
+from the module-init-tools project.")
+    (license license:gpl2+))) ; library under lgpl2.1+
+
+(define-public kmod
+  (package (inherit kmod-minimal)
     (name "kmod")
     (version "24")
     (source (origin
@@ -1946,15 +1973,14 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                (base32
                 "15xkkkzvca9flvkm48gkh8y8f13vlm3sl7nz9ydc7b3jy4fqs2v1"))
               (patches (search-patches "kmod-module-directory.patch"))))
-    (build-system gnu-build-system)
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (inputs
      `(("xz" ,xz)
        ("zlib" ,zlib)))
     (arguments
-     `(#:tests? #f ; FIXME: Investigate test failures
-       #:configure-flags '("--with-xz" "--with-zlib")
+     `(#:configure-flags '("--with-xz" "--with-zlib")
+       #:tests? #f ; FIXME: Investigate test failures
        #:phases (alist-cons-after
                  'install 'install-modprobe&co
                  (lambda* (#:key outputs #:allow-other-keys)
@@ -1964,18 +1990,9 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                                  (symlink "kmod"
                                           (string-append bin "/" tool)))
                                '("insmod" "rmmod" "lsmod" "modprobe"
-                                 "modinfo" "depmod"))))
-                 %standard-phases)))
-    (home-page "https://www.kernel.org/")
-    (synopsis "Kernel module tools")
-    (description "Kmod is a set of tools to handle common tasks with Linux
-kernel modules like insert, remove, list, check properties, resolve
-dependencies and aliases.
-
-These tools are designed on top of libkmod, a library that is shipped with
-kmod.  The aim is to be compatible with tools, configurations and indices
-from the module-init-tools project.")
-    (license license:gpl2+))) ; library under lgpl2.1+
+                                 "modinfo" "depmod"))
+                     #t))
+                 %standard-phases)))))
 
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
D
D
Danny Milosavljevic wrote on 25 Feb 2018 12:48
Download
[PATCH 2/4] gnu: Add kmod-minimal-static.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180225114816.869-2-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal/static): New variable.
---
gnu/packages/linux.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 44 insertions(+)

Toggle diff (55 lines)
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 1f8bf3050..b2e47f79a 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1994,6 +1994,50 @@ from the module-init-tools project.")
                      #t))
                  %standard-phases)))))
 
+(define-public kmod-minimal/static
+  (static-package
+   (package (inherit kmod-minimal)
+    (name "kmod-minimal-static")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (arguments
+     (substitute-keyword-arguments
+       (package-arguments (static-package kmod-minimal))
+       ((#:configure-flags flags ''())
+        `(cons* "--disable-manpages" "--disable-static" "--disable-shared" ,flags))
+       ((#:make-flags flags ''())
+        `(cons* "LDFLAGS=-all-static" ,flags))
+       ((#:phases phases '%standard-phases)
+        `(modify-phases ,phases
+          (delete 'install-license-files)
+          (add-after 'unpack 'patch-kmod
+           (lambda _
+             ;; Reduce size by 200 kiB.
+             (substitute* "tools/kmod.c"
+              (("[&]kmod_cmd_compat_lsmod,") "")
+              (("[&]kmod_cmd_compat_rmmod,") "")
+              (("[&]kmod_cmd_compat_insmod,") "")
+              (("[&]kmod_cmd_compat_modinfo,") ""))
+             #t))
+          (replace 'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let* ((out (assoc-ref outputs "out"))
+                     (bin (string-append out "/bin")))
+                (install-file "tools/kmod" bin)
+                (for-each
+                 (lambda (tool)
+                   (symlink "kmod" (string-append bin "/" tool)))
+                 '("modprobe" "depmod"))
+                #t))))))))))
+
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
   (package
D
D
Danny Milosavljevic wrote on 25 Feb 2018 12:48
Download
[PATCH 3/4] linux-initrd: Add kmod.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180225114816.869-3-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (raw-initrd): Add kmod.
(base-initrd): Add kmod.
(expression->initrd): Add kmod, linux-module-directory.
(flat-linux-module-directory): Add kmod; invoke depmod.
* gnu/build/linux-initrd.scm (build-initrd): Add kmod, linux-module-directory.
---
gnu/build/linux-initrd.scm | 13 +++++++++++-
gnu/system/linux-initrd.scm | 48 ++++++++++++++++++++++++++++++++++-----------
2 files changed, 49 insertions(+), 12 deletions(-)

Toggle diff (154 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..52cc180b4 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
+                       guile init kmod linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,17 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+    ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (if kmod
+        (begin
+          (mkdir-p "sbin")
+          (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe")))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 7170d1c0e..93089a869 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -59,6 +59,8 @@
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
+                             kmod
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -94,6 +96,8 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
+                        #:kmod #$kmod
+                        #:linux-module-directory #$linux-module-directory
                         ;; Copy everything INIT refers to into the initrd.
                         #:references-graphs '("closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
@@ -101,7 +105,7 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (gexp->derivation name builder
                     #:references-graphs `(("closure" ,init))))
 
-(define (flat-linux-module-directory linux modules)
+(define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
   (define build-exp
@@ -109,7 +113,7 @@ MODULES and taken from LINUX."
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
                        (srfi srfi-1)
                        (guix build utils)
                        (gnu build linux-modules))
@@ -138,13 +142,30 @@ MODULES and taken from LINUX."
                       (recursive-module-dependencies modules
                                                      #:lookup-module lookup))))
 
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
+          (define version
+            (car
+             (filter
+              (lambda (name)
+                (not (string-prefix? "." name)))
+              (scandir module-dir))))
+
+          (display "VERSION")
+          (display version)
+          (newline)
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (for-each (lambda (module)
+                        (format #t "copying '~a'...~%" module)
+                        (copy-file module
+                                   (string-append output "/"
+                                                  (basename module))))
+                      (delete-duplicates modules)))
+          (invoke (string-append #$kmod "/bin/depmod") "-a" "-b" #$output
+                  ; -E
+                  "-F" (string-append #$linux "/System.map")
+                  version)
+          #t)))
 
   (computed-file "linux-modules" build-exp))
 
@@ -152,6 +173,7 @@ MODULES and taken from LINUX."
                       #:key
                       (linux linux-libre)
                       (linux-modules '())
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       (helper-packages '())
                       qemu-networking?
@@ -185,7 +207,7 @@ upon error."
          mapped-devices))
 
   (define kodir
-    (flat-linux-module-directory linux linux-modules))
+    (flat-linux-module-directory linux linux-modules kmod))
 
   (expression->initrd
    (with-imported-modules (source-module-closure
@@ -223,6 +245,8 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:kmod kmod
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
@@ -245,6 +269,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?
                       volatile-root?
@@ -322,8 +347,9 @@ loaded at boot time in the order in which they appear."
   (raw-initrd file-systems
               #:linux linux
               #:linux-modules linux-modules
+              #:kmod kmod
               #:mapped-devices mapped-devices
-              #:helper-packages helper-packages
+              #:helper-packages (cons kmod helper-packages)
               #:qemu-networking? qemu-networking?
               #:volatile-root? volatile-root?
               #:on-error on-error))
D
D
Danny Milosavljevic wrote on 25 Feb 2018 12:48
Download
[PATCH 4/4] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180225114816.869-4-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 24 ++++++++++++++++++++----
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 23 insertions(+), 5 deletions(-)

Toggle diff (57 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..65c91c50f 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -473,6 +473,25 @@ upon error."
     (string-append linux-module-directory "/"
                    (ensure-dot-ko name)))
 
+  (define (load-kernel-modules)
+    (define enter?
+      (const #t))
+    (file-system-fold
+     enter?
+     ;; This is the Leaf handler.  It tries to modprobe all the modaliases.
+     (lambda (path stat result) ; leaf
+       (let ((modalias-name (string-append path "/modalias")))
+         (if (file-exists? modalias-name)
+             (let ((modalias (call-with-input-file modalias-name read-string)))
+               (if (not (string=? modalias ""))
+                   (system* "/sbin/modprobe" "-q" "--" modalias))))))
+     (const #t) ; down
+     (const #t) ; up
+     (const #f) ; skip
+     (const #f) ; error
+     #f ; init
+     "/sys/devices"))
+
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
 
@@ -486,10 +505,7 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 93089a869..573f4a324 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -228,7 +228,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
M
M
Mathieu Othacehe wrote on 25 Feb 2018 15:05
Download
Re: [bug#30604] [PATCH 3/4] linux-initrd: Add kmod.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)(address . 30604@debbugs.gnu.org)
87vaelf9ln.fsf@gmail.com
Download
Hi Danny,

Here are some small remarks,

Toggle quote (4 lines)
> + ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
> + (if kmod
> + (begin

You can use "when" to avoid "begin".

Toggle quote (3 lines)
> + (define version
> + (car

Prefer match to car/cdr use.

Toggle quote (9 lines)
> + (filter
> + (lambda (name)
> + (not (string-prefix? "." name)))
> + (scandir module-dir))))
> +
> + (display "VERSION")
> + (display version)
> + (newline)

(format #t "VERSION" ~a~%" version) would be shorter.

Toggle quote (2 lines)
> + ; -E

Why is this commented ?

Toggle quote (5 lines)
> + "-F" (string-append #$linux "/System.map")
> + version)
> + #t)))
>

Thanks,

Mathieu
D
D
Danny Milosavljevic wrote on 25 Feb 2018 16:07
Download
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)(address . 30604@debbugs.gnu.org)
20180225160750.46bf5b50@scratchpost.org
Download
Hi Mathieu,

thanks for the review.

On Sun, 25 Feb 2018 15:05:24 +0100
Mathieu Othacehe <m.othacehe@gmail.com> wrote:

Toggle quote (4 lines)
> > + ; -E
>
> Why is this commented ?

Because it's an option for specifying the location of "Module.symvers" - and
I don't know whether guix uses it (probably not). If one doesn't specify an
option, depmod will default to the running kernel - which is not what we want.

I should elaborate in the comment that, if we start using Module.symvers, we
MUST pass "-E" there. Maybe better to even just check for the file existence
and add it right now, otherwise we might forget later. What do you think?
M
M
Marius Bakke wrote on 26 Feb 2018 02:10
Download
Re: [bug#30604] [PATCH 1/4] gnu: kmod: Split off kmod-minimal.
87h8q4wo7d.fsf@fastmail.com
Download
Danny Milosavljevic <dannym@scratchpost.org> writes:

Toggle quote (20 lines)
> * gnu/packages/linux.scm (kmod-minimal): New variable.
> (kmod): Modify.
> ---
> gnu/packages/linux.scm | 49 +++++++++++++++++++++++++++++++++----------------
> 1 file changed, 33 insertions(+), 16 deletions(-)
>
> diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
> index 238398e84..1f8bf3050 100644
> --- a/gnu/packages/linux.scm
> +++ b/gnu/packages/linux.scm
> @@ -1933,8 +1933,35 @@ for systems using the Linux kernel. This includes commands such as
> to use Linux' inotify mechanism, which allows file accesses to be monitored.")
> (license license:gpl2+)))
>
> -(define-public kmod
> +(define kmod-minimal
> (package
> + (name "kmod-minimal")
> + (version "13")

Why this old version?

Toggle quote (10 lines)
> + (source (origin
> + (method url-fetch)
> + (uri
> + (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
> + "kmod-" version ".tar.xz"))
> + (sha256
> + (base32
> + "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
> + (patches (search-patches "kmod-13-module-directory.patch"))))

This patch seems to be missing.

Toggle quote (59 lines)
> + (build-system gnu-build-system)
> + (arguments
> + `(#:tests? #f)) ; FIXME: Investigate test failures
> + (home-page "https://www.kernel.org/")
> + (synopsis "Kernel module tools")
> + (description "Kmod is a set of tools to handle common tasks with Linux
> +kernel modules like insert, remove, list, check properties, resolve
> +dependencies and aliases.
> +
> +These tools are designed on top of libkmod, a library that is shipped with
> +kmod. The aim is to be compatible with tools, configurations and indices
> +from the module-init-tools project.")
> + (license license:gpl2+))) ; library under lgpl2.1+
> +
> +(define-public kmod
> + (package (inherit kmod-minimal)
> (name "kmod")
> (version "24")
> (source (origin
> @@ -1946,15 +1973,14 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
> (base32
> "15xkkkzvca9flvkm48gkh8y8f13vlm3sl7nz9ydc7b3jy4fqs2v1"))
> (patches (search-patches "kmod-module-directory.patch"))))
> - (build-system gnu-build-system)
> (native-inputs
> `(("pkg-config" ,pkg-config)))
> (inputs
> `(("xz" ,xz)
> ("zlib" ,zlib)))
> (arguments
> - `(#:tests? #f ; FIXME: Investigate test failures
> - #:configure-flags '("--with-xz" "--with-zlib")
> + `(#:configure-flags '("--with-xz" "--with-zlib")
> + #:tests? #f ; FIXME: Investigate test failures
> #:phases (alist-cons-after
> 'install 'install-modprobe&co
> (lambda* (#:key outputs #:allow-other-keys)
> @@ -1964,18 +1990,9 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
> (symlink "kmod"
> (string-append bin "/" tool)))
> '("insmod" "rmmod" "lsmod" "modprobe"
> - "modinfo" "depmod"))))
> - %standard-phases)))
> - (home-page "https://www.kernel.org/")
> - (synopsis "Kernel module tools")
> - (description "Kmod is a set of tools to handle common tasks with Linux
> -kernel modules like insert, remove, list, check properties, resolve
> -dependencies and aliases.
> -
> -These tools are designed on top of libkmod, a library that is shipped with
> -kmod. The aim is to be compatible with tools, configurations and indices
> -from the module-init-tools project.")
> - (license license:gpl2+))) ; library under lgpl2.1+
> + "modinfo" "depmod"))
> + #t))
> + %standard-phases)))))
>
> (define-public eudev
> ;; The post-systemd fork, maintained by Gentoo.
Download
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCgAdFiEEu7At3yzq9qgNHeZDoqBt8qM6VPoFAlqTXnYACgkQoqBt8qM6
VPpGtAf9HdKJjuRHFJxIT76qB3Yjub3mj5c3LRNhSA1vPnaPEMOXVDDTlq4t8XcR
K0oaixbKYcSvSmHJ+Sp17jy+SYpeA1WGGpCxKVsBl8FCKhEYh2ztbgRUtMwjXZyF
ZjO15dLd2SU40hWXVabKDeDTZyD9whMZMrbKAmu1OelG9lSPJw7fWfSU8UnZeXJg
TflXbAN+9Ikm5ey4kxY/v+IjE60aWd5CRlUqcWVzKzZ7bSmU81r+paUWSe+11V7n
7LoBFm/MwQM3JFkglmSkWsDv/9eQwfm6CI6yV15qChL+MXuSFKzuJNKeETd7TvV9
P8zks8IDY7CA9I3PwJXPEZRuwA7QYw==
=YgmH
-----END PGP SIGNATURE-----

D
D
Danny Milosavljevic wrote on 26 Feb 2018 04:50
Download
[PATCH v2 1/6] gnu: kmod: Split off kmod-minimal.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226035025.1698-2-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal): New variable.
(kmod): Modify.
---
gnu/packages/linux.scm | 49 +++++++++++++++++++++++++++++++++----------------
1 file changed, 33 insertions(+), 16 deletions(-)

Toggle diff (81 lines)
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 238398e84..1f8bf3050 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1933,8 +1933,35 @@ for systems using the Linux kernel.  This includes commands such as
 to use Linux' inotify mechanism, which allows file accesses to be monitored.")
     (license license:gpl2+)))
 
-(define-public kmod
+(define kmod-minimal
   (package
+    (name "kmod-minimal")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f)) ; FIXME: Investigate test failures
+    (home-page "https://www.kernel.org/")
+    (synopsis "Kernel module tools")
+    (description "Kmod is a set of tools to handle common tasks with Linux
+kernel modules like insert, remove, list, check properties, resolve
+dependencies and aliases.
+
+These tools are designed on top of libkmod, a library that is shipped with
+kmod.  The aim is to be compatible with tools, configurations and indices
+from the module-init-tools project.")
+    (license license:gpl2+))) ; library under lgpl2.1+
+
+(define-public kmod
+  (package (inherit kmod-minimal)
     (name "kmod")
     (version "24")
     (source (origin
@@ -1946,15 +1973,14 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                (base32
                 "15xkkkzvca9flvkm48gkh8y8f13vlm3sl7nz9ydc7b3jy4fqs2v1"))
               (patches (search-patches "kmod-module-directory.patch"))))
-    (build-system gnu-build-system)
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (inputs
      `(("xz" ,xz)
        ("zlib" ,zlib)))
     (arguments
-     `(#:tests? #f ; FIXME: Investigate test failures
-       #:configure-flags '("--with-xz" "--with-zlib")
+     `(#:configure-flags '("--with-xz" "--with-zlib")
+       #:tests? #f ; FIXME: Investigate test failures
        #:phases (alist-cons-after
                  'install 'install-modprobe&co
                  (lambda* (#:key outputs #:allow-other-keys)
@@ -1964,18 +1990,9 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                                  (symlink "kmod"
                                           (string-append bin "/" tool)))
                                '("insmod" "rmmod" "lsmod" "modprobe"
-                                 "modinfo" "depmod"))))
-                 %standard-phases)))
-    (home-page "https://www.kernel.org/")
-    (synopsis "Kernel module tools")
-    (description "Kmod is a set of tools to handle common tasks with Linux
-kernel modules like insert, remove, list, check properties, resolve
-dependencies and aliases.
-
-These tools are designed on top of libkmod, a library that is shipped with
-kmod.  The aim is to be compatible with tools, configurations and indices
-from the module-init-tools project.")
-    (license license:gpl2+))) ; library under lgpl2.1+
+                                 "modinfo" "depmod"))
+                     #t))
+                 %standard-phases)))))
 
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
D
D
Danny Milosavljevic wrote on 26 Feb 2018 04:50
Download
[PATCH v2 2/6] gnu: Add kmod-minimal-static.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226035025.1698-3-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal/static): New variable.
* gnu/packages/patches/kmod-13-module-directory.patch: New file.
* gnu/local.mk: Add it.
---
gnu/local.mk | 1 +
gnu/packages/linux.scm | 44 ++++++++++++++++++++++
.../patches/kmod-13-module-directory.patch | 33 ++++++++++++++++
3 files changed, 78 insertions(+)
create mode 100644 gnu/packages/patches/kmod-13-module-directory.patch

Toggle diff (106 lines)
diff --git a/gnu/local.mk b/gnu/local.mk
index 21195f8c1..b1e3c878d 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -795,6 +795,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/kiki-makefile.patch			\
   %D%/packages/patches/kiki-missing-includes.patch		\
   %D%/packages/patches/kiki-portability-64bit.patch		\
+  %D%/packages/patches/kmod-13-module-directory.patch		\
   %D%/packages/patches/kmod-module-directory.patch		\
   %D%/packages/patches/kobodeluxe-paths.patch			\
   %D%/packages/patches/kobodeluxe-enemies-pipe-decl.patch	\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 1f8bf3050..b2e47f79a 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1994,6 +1994,50 @@ from the module-init-tools project.")
                      #t))
                  %standard-phases)))))
 
+(define-public kmod-minimal/static
+  (static-package
+   (package (inherit kmod-minimal)
+    (name "kmod-minimal-static")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (arguments
+     (substitute-keyword-arguments
+       (package-arguments (static-package kmod-minimal))
+       ((#:configure-flags flags ''())
+        `(cons* "--disable-manpages" "--disable-static" "--disable-shared" ,flags))
+       ((#:make-flags flags ''())
+        `(cons* "LDFLAGS=-all-static" ,flags))
+       ((#:phases phases '%standard-phases)
+        `(modify-phases ,phases
+          (delete 'install-license-files)
+          (add-after 'unpack 'patch-kmod
+           (lambda _
+             ;; Reduce size by 200 kiB.
+             (substitute* "tools/kmod.c"
+              (("[&]kmod_cmd_compat_lsmod,") "")
+              (("[&]kmod_cmd_compat_rmmod,") "")
+              (("[&]kmod_cmd_compat_insmod,") "")
+              (("[&]kmod_cmd_compat_modinfo,") ""))
+             #t))
+          (replace 'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let* ((out (assoc-ref outputs "out"))
+                     (bin (string-append out "/bin")))
+                (install-file "tools/kmod" bin)
+                (for-each
+                 (lambda (tool)
+                   (symlink "kmod" (string-append bin "/" tool)))
+                 '("modprobe" "depmod"))
+                #t))))))))))
+
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
   (package
diff --git a/gnu/packages/patches/kmod-13-module-directory.patch b/gnu/packages/patches/kmod-13-module-directory.patch
new file mode 100644
index 000000000..5ff2f8a60
--- /dev/null
+++ b/gnu/packages/patches/kmod-13-module-directory.patch
@@ -0,0 +1,33 @@
+This patch changes libkmod so it honors the 'LINUX_MODULE_DIRECTORY'
+environment variable, rather than looking for modules exclusively in
+/lib/modules.
+
+Patch by Shea Levy and Eelco Dolstra, from Nixpkgs; adjusted to
+use 'LINUX_MODULE_DIRECTORY' rather than 'MODULE_DIR' as the variable
+name.
+
+
+--- kmod-7/libkmod/libkmod.c	2012-03-15 08:19:16.750010226 -0400
++++ kmod-7/libkmod/libkmod.c	2012-04-04 15:21:29.532074313 -0400
+@@ -200,7 +200,7 @@
+ static char *get_kernel_release(const char *dirname)
+ {
+ 	struct utsname u;
+-	char *p;
++	char *p, *dirname_prefix;
+ 
+ 	if (dirname != NULL)
+ 		return path_make_absolute_cwd(dirname);
+@@ -208,7 +208,10 @@
+ 	if (uname(&u) < 0)
+ 		return NULL;
+ 
+-	if (asprintf(&p, "%s/%s", dirname_default_prefix, u.release) < 0)
++	if ((dirname_prefix = getenv("LINUX_MODULE_DIRECTORY")) == NULL)
++		dirname_prefix = dirname_default_prefix;
++
++	if (asprintf(&p, "%s/%s", dirname_prefix, u.release) < 0)
+ 		return NULL;
+ 
+ 	return p;
+
D
D
Danny Milosavljevic wrote on 26 Feb 2018 04:50
Download
[PATCH v2 0/6] Load Linux module only when supported hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226035025.1698-1-dannym@scratchpost.org
Download
Danny Milosavljevic (6):
gnu: kmod: Split off kmod-minimal.
gnu: Add kmod-minimal-static.
linux-initrd: Add kmod.
linux-boot: Load kernel modules only when the hardware is present.
vm: Allow qemu-image builder to load Linux kernel modules.
vm: Make the virtio-blk is uniquely identifyable in /sys.

gnu/build/linux-boot.scm | 31 +++++++-
gnu/build/linux-initrd.scm | 12 ++-
gnu/build/vm.scm | 2 +-
gnu/local.mk | 1 +
gnu/packages/linux.scm | 91 ++++++++++++++++++----
.../patches/kmod-13-module-directory.patch | 33 ++++++++
gnu/system/linux-initrd.scm | 48 +++++++++---
gnu/system/vm.scm | 28 ++++++-
8 files changed, 210 insertions(+), 36 deletions(-)
create mode 100644 gnu/packages/patches/kmod-13-module-directory.patch
D
D
Danny Milosavljevic wrote on 26 Feb 2018 04:50
Download
[PATCH v2 3/6] linux-initrd: Add kmod.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226035025.1698-4-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (raw-initrd): Add kmod.
(base-initrd): Add kmod.
(expression->initrd): Add kmod, linux-module-directory.
(flat-linux-module-directory): Add kmod; invoke depmod.
* gnu/build/linux-initrd.scm (build-initrd): Add kmod, linux-module-directory.
---
gnu/build/linux-initrd.scm | 12 +++++++++++-
gnu/system/linux-initrd.scm | 44 +++++++++++++++++++++++++++++++++-----------
2 files changed, 44 insertions(+), 12 deletions(-)

Toggle diff (149 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..6356007df 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
+                       guile init kmod linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,16 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+    ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when kmod
+      (mkdir-p "sbin")
+      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 7170d1c0e..91e498787 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -59,6 +59,8 @@
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
+                             kmod
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -94,6 +96,8 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
+                        #:kmod #$kmod
+                        #:linux-module-directory #$linux-module-directory
                         ;; Copy everything INIT refers to into the initrd.
                         #:references-graphs '("closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
@@ -101,7 +105,7 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (gexp->derivation name builder
                     #:references-graphs `(("closure" ,init))))
 
-(define (flat-linux-module-directory linux modules)
+(define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
   (define build-exp
@@ -109,7 +113,7 @@ MODULES and taken from LINUX."
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
                        (srfi srfi-1)
                        (guix build utils)
                        (gnu build linux-modules))
@@ -138,13 +142,26 @@ MODULES and taken from LINUX."
                       (recursive-module-dependencies modules
                                                      #:lookup-module lookup))))
 
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
+          (define version
+            (car
+             (filter
+              (lambda (name)
+                (not (string-prefix? "." name)))
+              (scandir module-dir))))
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (for-each (lambda (module)
+                        (format #t "copying '~a'...~%" module)
+                        (copy-file module
+                                   (string-append output "/"
+                                                  (basename module))))
+                      (delete-duplicates modules)))
+          (invoke (string-append #$kmod "/bin/depmod") "-a" "-b" #$output
+                  ; -E
+                  "-F" (string-append #$linux "/System.map")
+                  version)
+          #t)))
 
   (computed-file "linux-modules" build-exp))
 
@@ -152,6 +169,7 @@ MODULES and taken from LINUX."
                       #:key
                       (linux linux-libre)
                       (linux-modules '())
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       (helper-packages '())
                       qemu-networking?
@@ -185,7 +203,7 @@ upon error."
          mapped-devices))
 
   (define kodir
-    (flat-linux-module-directory linux linux-modules))
+    (flat-linux-module-directory linux linux-modules kmod))
 
   (expression->initrd
    (with-imported-modules (source-module-closure
@@ -223,6 +241,8 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:kmod kmod
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
@@ -245,6 +265,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?
                       volatile-root?
@@ -322,8 +343,9 @@ loaded at boot time in the order in which they appear."
   (raw-initrd file-systems
               #:linux linux
               #:linux-modules linux-modules
+              #:kmod kmod
               #:mapped-devices mapped-devices
-              #:helper-packages helper-packages
+              #:helper-packages (cons kmod helper-packages)
               #:qemu-networking? qemu-networking?
               #:volatile-root? volatile-root?
               #:on-error on-error))
D
D
Danny Milosavljevic wrote on 26 Feb 2018 04:50
Download
[PATCH v2 4/6] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226035025.1698-5-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 31 +++++++++++++++++++++++++++----
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 30 insertions(+), 5 deletions(-)

Toggle diff (64 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..6d00ea9be 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -473,6 +473,32 @@ upon error."
     (string-append linux-module-directory "/"
                    (ensure-dot-ko name)))
 
+  (define (load-kernel-modules)
+    "Examine /sys/devices to find out which modules to load and load them."
+    (define enter?
+      (const #t))
+    (define (down! path stat result)
+     ;; Note: modprobe mutates the tree starting with path.
+     (let ((modalias-name (string-append path "/modalias")))
+       (if (file-exists? modalias-name)
+           (let ((modalias
+                 (string-trim-right (call-with-input-file modalias-name
+                                                          read-string)
+                                    #\newline)))
+             (system* "/sbin/modprobe" "-q" "--" modalias))))
+       #t)
+    (define up
+      (const #t))
+    (define skip
+      (const #t))
+    (define leaf
+      (const #t))
+    (define (error name stat errno result)
+      (format (current-error-port) "warning: ~a: ~a~%"
+              name (strerror errno))
+      result)
+    (file-system-fold enter? leaf down! up skip error #t "/sys/devices"))
+
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
 
@@ -486,10 +512,7 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 91e498787..6d130ccac 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -224,7 +224,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
D
D
Danny Milosavljevic wrote on 26 Feb 2018 04:50
Download
[PATCH v2 5/6] vm: Allow qemu-image builder to load Linux kernel modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226035025.1698-6-dannym@scratchpost.org
Download
* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
gnu/system/vm.scm | 25 +++++++++++++++++++++++--
1 file changed, 23 insertions(+), 2 deletions(-)

Toggle diff (64 lines)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd..c64c9678f 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,6 +286,8 @@ INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
    (with-imported-modules (source-module-closure '((gnu build bootloader)
@@ -288,7 +301,7 @@ the image."
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +315,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +385,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 
 ;;;
D
D
Danny Milosavljevic wrote on 26 Feb 2018 04:50
Download
[PATCH v2 6/6] vm: Make the virtio-blk is uniquely identifyable in /sys.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226035025.1698-7-dannym@scratchpost.org
Download
* gnu/build/vm.scm (load-in-linux-vm): Set virtio-blk pci addr to 0x10.
* gnu/system/vm.scm (common-qemu-options): Set virtio-blk pci addr to 0x10.
---
gnu/build/vm.scm | 2 +-
gnu/system/vm.scm | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)

Toggle diff (27 lines)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..ebf9e9f6e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -154,7 +154,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-device" "virtio-blk,drive=myhd"
+                       `("-device" "virtio-blk-pci,addr=0x10,drive=myhd"
                          "-drive" ,(string-append "if=none,file=" output
                                                   ",format=" disk-image-format
                                                   ",id=myhd"))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index c64c9678f..ad48999ee 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -704,7 +704,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+     "-device" "virtio-blk-pci,addr=0x10,drive=myhd"
+     (format #f "-drive id=myhd,file=~a,if=none,cache=writeback,werror=report,readonly"
              #$image)))
 
 (define* (system-qemu-image/shared-store-script os
D
D
Danny Milosavljevic wrote on 26 Feb 2018 05:06
Download
[PATCH v3 1/6] gnu: kmod: Split off kmod-minimal.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226040609.3066-2-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal): New variable.
(kmod): Modify.
---
gnu/packages/linux.scm | 49 +++++++++++++++++++++++++++++++++----------------
1 file changed, 33 insertions(+), 16 deletions(-)

Toggle diff (81 lines)
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 238398e84..1f8bf3050 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1933,8 +1933,35 @@ for systems using the Linux kernel.  This includes commands such as
 to use Linux' inotify mechanism, which allows file accesses to be monitored.")
     (license license:gpl2+)))
 
-(define-public kmod
+(define kmod-minimal
   (package
+    (name "kmod-minimal")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f)) ; FIXME: Investigate test failures
+    (home-page "https://www.kernel.org/")
+    (synopsis "Kernel module tools")
+    (description "Kmod is a set of tools to handle common tasks with Linux
+kernel modules like insert, remove, list, check properties, resolve
+dependencies and aliases.
+
+These tools are designed on top of libkmod, a library that is shipped with
+kmod.  The aim is to be compatible with tools, configurations and indices
+from the module-init-tools project.")
+    (license license:gpl2+))) ; library under lgpl2.1+
+
+(define-public kmod
+  (package (inherit kmod-minimal)
     (name "kmod")
     (version "24")
     (source (origin
@@ -1946,15 +1973,14 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                (base32
                 "15xkkkzvca9flvkm48gkh8y8f13vlm3sl7nz9ydc7b3jy4fqs2v1"))
               (patches (search-patches "kmod-module-directory.patch"))))
-    (build-system gnu-build-system)
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (inputs
      `(("xz" ,xz)
        ("zlib" ,zlib)))
     (arguments
-     `(#:tests? #f ; FIXME: Investigate test failures
-       #:configure-flags '("--with-xz" "--with-zlib")
+     `(#:configure-flags '("--with-xz" "--with-zlib")
+       #:tests? #f ; FIXME: Investigate test failures
        #:phases (alist-cons-after
                  'install 'install-modprobe&co
                  (lambda* (#:key outputs #:allow-other-keys)
@@ -1964,18 +1990,9 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                                  (symlink "kmod"
                                           (string-append bin "/" tool)))
                                '("insmod" "rmmod" "lsmod" "modprobe"
-                                 "modinfo" "depmod"))))
-                 %standard-phases)))
-    (home-page "https://www.kernel.org/")
-    (synopsis "Kernel module tools")
-    (description "Kmod is a set of tools to handle common tasks with Linux
-kernel modules like insert, remove, list, check properties, resolve
-dependencies and aliases.
-
-These tools are designed on top of libkmod, a library that is shipped with
-kmod.  The aim is to be compatible with tools, configurations and indices
-from the module-init-tools project.")
-    (license license:gpl2+))) ; library under lgpl2.1+
+                                 "modinfo" "depmod"))
+                     #t))
+                 %standard-phases)))))
 
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
D
D
Danny Milosavljevic wrote on 26 Feb 2018 05:06
Download
[PATCH v3 0/6] Load Linux module only when supported hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226040609.3066-1-dannym@scratchpost.org
Download
Danny Milosavljevic (6):
gnu: kmod: Split off kmod-minimal.
gnu: Add kmod-minimal-static.
linux-initrd: Add kmod.
linux-boot: Load kernel modules only when the hardware is present.
vm: Allow qemu-image builder to load Linux kernel modules.
vm: Make the virtio-blk is uniquely identifyable in /sys.

gnu/build/linux-boot.scm | 31 +++++++-
gnu/build/linux-initrd.scm | 12 ++-
gnu/build/vm.scm | 2 +-
gnu/local.mk | 1 +
gnu/packages/linux.scm | 91 ++++++++++++++++++----
.../patches/kmod-13-module-directory.patch | 33 ++++++++
gnu/system/linux-initrd.scm | 49 +++++++++---
gnu/system/vm.scm | 34 ++++++--
8 files changed, 215 insertions(+), 38 deletions(-)
create mode 100644 gnu/packages/patches/kmod-13-module-directory.patch
D
D
Danny Milosavljevic wrote on 26 Feb 2018 05:06
Download
[PATCH v3 2/6] gnu: Add kmod-minimal-static.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226040609.3066-3-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal/static): New variable.
* gnu/packages/patches/kmod-13-module-directory.patch: New file.
* gnu/local.mk: Add it.
---
gnu/local.mk | 1 +
gnu/packages/linux.scm | 44 ++++++++++++++++++++++
.../patches/kmod-13-module-directory.patch | 33 ++++++++++++++++
3 files changed, 78 insertions(+)
create mode 100644 gnu/packages/patches/kmod-13-module-directory.patch

Toggle diff (106 lines)
diff --git a/gnu/local.mk b/gnu/local.mk
index 21195f8c1..b1e3c878d 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -795,6 +795,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/kiki-makefile.patch			\
   %D%/packages/patches/kiki-missing-includes.patch		\
   %D%/packages/patches/kiki-portability-64bit.patch		\
+  %D%/packages/patches/kmod-13-module-directory.patch		\
   %D%/packages/patches/kmod-module-directory.patch		\
   %D%/packages/patches/kobodeluxe-paths.patch			\
   %D%/packages/patches/kobodeluxe-enemies-pipe-decl.patch	\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 1f8bf3050..b2e47f79a 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1994,6 +1994,50 @@ from the module-init-tools project.")
                      #t))
                  %standard-phases)))))
 
+(define-public kmod-minimal/static
+  (static-package
+   (package (inherit kmod-minimal)
+    (name "kmod-minimal-static")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (arguments
+     (substitute-keyword-arguments
+       (package-arguments (static-package kmod-minimal))
+       ((#:configure-flags flags ''())
+        `(cons* "--disable-manpages" "--disable-static" "--disable-shared" ,flags))
+       ((#:make-flags flags ''())
+        `(cons* "LDFLAGS=-all-static" ,flags))
+       ((#:phases phases '%standard-phases)
+        `(modify-phases ,phases
+          (delete 'install-license-files)
+          (add-after 'unpack 'patch-kmod
+           (lambda _
+             ;; Reduce size by 200 kiB.
+             (substitute* "tools/kmod.c"
+              (("[&]kmod_cmd_compat_lsmod,") "")
+              (("[&]kmod_cmd_compat_rmmod,") "")
+              (("[&]kmod_cmd_compat_insmod,") "")
+              (("[&]kmod_cmd_compat_modinfo,") ""))
+             #t))
+          (replace 'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let* ((out (assoc-ref outputs "out"))
+                     (bin (string-append out "/bin")))
+                (install-file "tools/kmod" bin)
+                (for-each
+                 (lambda (tool)
+                   (symlink "kmod" (string-append bin "/" tool)))
+                 '("modprobe" "depmod"))
+                #t))))))))))
+
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
   (package
diff --git a/gnu/packages/patches/kmod-13-module-directory.patch b/gnu/packages/patches/kmod-13-module-directory.patch
new file mode 100644
index 000000000..5ff2f8a60
--- /dev/null
+++ b/gnu/packages/patches/kmod-13-module-directory.patch
@@ -0,0 +1,33 @@
+This patch changes libkmod so it honors the 'LINUX_MODULE_DIRECTORY'
+environment variable, rather than looking for modules exclusively in
+/lib/modules.
+
+Patch by Shea Levy and Eelco Dolstra, from Nixpkgs; adjusted to
+use 'LINUX_MODULE_DIRECTORY' rather than 'MODULE_DIR' as the variable
+name.
+
+
+--- kmod-7/libkmod/libkmod.c	2012-03-15 08:19:16.750010226 -0400
++++ kmod-7/libkmod/libkmod.c	2012-04-04 15:21:29.532074313 -0400
+@@ -200,7 +200,7 @@
+ static char *get_kernel_release(const char *dirname)
+ {
+ 	struct utsname u;
+-	char *p;
++	char *p, *dirname_prefix;
+ 
+ 	if (dirname != NULL)
+ 		return path_make_absolute_cwd(dirname);
+@@ -208,7 +208,10 @@
+ 	if (uname(&u) < 0)
+ 		return NULL;
+ 
+-	if (asprintf(&p, "%s/%s", dirname_default_prefix, u.release) < 0)
++	if ((dirname_prefix = getenv("LINUX_MODULE_DIRECTORY")) == NULL)
++		dirname_prefix = dirname_default_prefix;
++
++	if (asprintf(&p, "%s/%s", dirname_prefix, u.release) < 0)
+ 		return NULL;
+ 
+ 	return p;
+
D
D
Danny Milosavljevic wrote on 26 Feb 2018 05:06
Download
[PATCH v3 3/6] linux-initrd: Add kmod.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226040609.3066-4-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (raw-initrd): Add kmod.
(base-initrd): Add kmod.
(expression->initrd): Add kmod, linux-module-directory.
(flat-linux-module-directory): Add kmod; invoke depmod.
* gnu/build/linux-initrd.scm (build-initrd): Add kmod, linux-module-directory.
---
gnu/build/linux-initrd.scm | 12 +++++++++++-
gnu/system/linux-initrd.scm | 45 ++++++++++++++++++++++++++++++++++-----------
2 files changed, 45 insertions(+), 12 deletions(-)

Toggle diff (150 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..6356007df 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
+                       guile init kmod linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,16 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+    ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when kmod
+      (mkdir-p "sbin")
+      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 7170d1c0e..46ef055f0 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -59,6 +59,8 @@
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
+                             kmod
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -94,6 +96,8 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
+                        #:kmod #$kmod
+                        #:linux-module-directory #$linux-module-directory
                         ;; Copy everything INIT refers to into the initrd.
                         #:references-graphs '("closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
@@ -101,7 +105,7 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (gexp->derivation name builder
                     #:references-graphs `(("closure" ,init))))
 
-(define (flat-linux-module-directory linux modules)
+(define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
   (define build-exp
@@ -109,7 +113,7 @@ MODULES and taken from LINUX."
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
                        (srfi srfi-1)
                        (guix build utils)
                        (gnu build linux-modules))
@@ -138,13 +142,27 @@ MODULES and taken from LINUX."
                       (recursive-module-dependencies modules
                                                      #:lookup-module lookup))))
 
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
+          (define version
+            (match
+             (filter
+              (lambda (name)
+                (not (string-prefix? "." name)))
+              (scandir module-dir))
+             ((item) item)))
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (for-each (lambda (module)
+                        (format #t "copying '~a'...~%" module)
+                        (copy-file module
+                                   (string-append output "/"
+                                                  (basename module))))
+                      (delete-duplicates modules)))
+          (invoke (string-append #$kmod "/bin/depmod") "-a" "-b" #$output
+                  ; -E
+                  "-F" (string-append #$linux "/System.map")
+                  version)
+          #t)))
 
   (computed-file "linux-modules" build-exp))
 
@@ -152,6 +170,7 @@ MODULES and taken from LINUX."
                       #:key
                       (linux linux-libre)
                       (linux-modules '())
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       (helper-packages '())
                       qemu-networking?
@@ -185,7 +204,7 @@ upon error."
          mapped-devices))
 
   (define kodir
-    (flat-linux-module-directory linux linux-modules))
+    (flat-linux-module-directory linux linux-modules kmod))
 
   (expression->initrd
    (with-imported-modules (source-module-closure
@@ -223,6 +242,8 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:kmod kmod
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
@@ -245,6 +266,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?
                       volatile-root?
@@ -322,8 +344,9 @@ loaded at boot time in the order in which they appear."
   (raw-initrd file-systems
               #:linux linux
               #:linux-modules linux-modules
+              #:kmod kmod
               #:mapped-devices mapped-devices
-              #:helper-packages helper-packages
+              #:helper-packages (cons kmod helper-packages)
               #:qemu-networking? qemu-networking?
               #:volatile-root? volatile-root?
               #:on-error on-error))
D
D
Danny Milosavljevic wrote on 26 Feb 2018 05:06
Download
[PATCH v3 4/6] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226040609.3066-5-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 31 +++++++++++++++++++++++++++----
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 30 insertions(+), 5 deletions(-)

Toggle diff (64 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..6d00ea9be 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -473,6 +473,32 @@ upon error."
     (string-append linux-module-directory "/"
                    (ensure-dot-ko name)))
 
+  (define (load-kernel-modules)
+    "Examine /sys/devices to find out which modules to load and load them."
+    (define enter?
+      (const #t))
+    (define (down! path stat result)
+     ;; Note: modprobe mutates the tree starting with path.
+     (let ((modalias-name (string-append path "/modalias")))
+       (if (file-exists? modalias-name)
+           (let ((modalias
+                 (string-trim-right (call-with-input-file modalias-name
+                                                          read-string)
+                                    #\newline)))
+             (system* "/sbin/modprobe" "-q" "--" modalias))))
+       #t)
+    (define up
+      (const #t))
+    (define skip
+      (const #t))
+    (define leaf
+      (const #t))
+    (define (error name stat errno result)
+      (format (current-error-port) "warning: ~a: ~a~%"
+              name (strerror errno))
+      result)
+    (file-system-fold enter? leaf down! up skip error #t "/sys/devices"))
+
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
 
@@ -486,10 +512,7 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 46ef055f0..c8a9e4950 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -225,7 +225,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
D
D
Danny Milosavljevic wrote on 26 Feb 2018 05:06
Download
[PATCH v3 5/6] vm: Allow qemu-image builder to load Linux kernel modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226040609.3066-6-dannym@scratchpost.org
Download
* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
gnu/system/vm.scm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)

Toggle diff (74 lines)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd..b5a559012 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,20 +286,24 @@ INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
+   (with-imported-modules (source-module-closure '((gnu build activation)
+                                                   (gnu build bootloader)
                                                    (gnu build vm)
                                                    (guix build utils)))
      #~(begin
-         (use-modules (gnu build bootloader)
+         (use-modules (gnu build activation)
+                      (gnu build bootloader)
                       (gnu build vm)
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +317,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +387,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 
 ;;;
D
D
Danny Milosavljevic wrote on 26 Feb 2018 05:06
Download
[PATCH v3 6/6] vm: Make the virtio-blk is uniquely identifyable in /sys.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180226040609.3066-7-dannym@scratchpost.org
Download
* gnu/build/vm.scm (load-in-linux-vm): Set virtio-blk pci addr to 0x10.
* gnu/system/vm.scm (common-qemu-options): Set virtio-blk pci addr to 0x10.
---
gnu/build/vm.scm | 2 +-
gnu/system/vm.scm | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)

Toggle diff (27 lines)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..ebf9e9f6e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -154,7 +154,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-device" "virtio-blk,drive=myhd"
+                       `("-device" "virtio-blk-pci,addr=0x10,drive=myhd"
                          "-drive" ,(string-append "if=none,file=" output
                                                   ",format=" disk-image-format
                                                   ",id=myhd"))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index b5a559012..fdff64ed9 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -706,7 +706,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+     "-device" "virtio-blk-pci,addr=0x10,drive=myhd"
+     (format #f "-drive id=myhd,file=~a,if=none,cache=writeback,werror=report,readonly"
              #$image)))
 
 (define* (system-qemu-image/shared-store-script os
M
M
Mathieu Othacehe wrote on 26 Feb 2018 12:51
Download
Re: [bug#30604] [PATCH 3/4] linux-initrd: Add kmod.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)(address . 30604@debbugs.gnu.org)
87h8q4j7e0.fsf@gmail.com
Download
Hey Danny,

Toggle quote (8 lines)
> Because it's an option for specifying the location of "Module.symvers" - and
> I don't know whether guix uses it (probably not). If one doesn't specify an
> option, depmod will default to the running kernel - which is not what we want.
>
> I should elaborate in the comment that, if we start using Module.symvers, we
> MUST pass "-E" there. Maybe better to even just check for the file existence
> and add it right now, otherwise we might forget later. What do you think?

Reading 'depmod' manpage, I understand that -E and -F are mutually
exclusive. Both options seem to have an interest only if -e is supplied
to "reports any symbols which a module needs which are not supplied by
other modules or the kernel".

So maybe something like "-F (string-append #$linux "/System.map") -e"
would make more sense ?

Mathieu
D
D
Danny Milosavljevic wrote on 27 Feb 2018 12:26
Download
[PATCH v4 1/7] gnu: kmod: Split off kmod-minimal.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227112619.5071-2-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal): New variable.
(kmod): Modify.
---
gnu/packages/linux.scm | 49 +++++++++++++++++++++++++++++++++----------------
1 file changed, 33 insertions(+), 16 deletions(-)

Toggle diff (81 lines)
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 238398e84..1f8bf3050 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1933,8 +1933,35 @@ for systems using the Linux kernel.  This includes commands such as
 to use Linux' inotify mechanism, which allows file accesses to be monitored.")
     (license license:gpl2+)))
 
-(define-public kmod
+(define kmod-minimal
   (package
+    (name "kmod-minimal")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f)) ; FIXME: Investigate test failures
+    (home-page "https://www.kernel.org/")
+    (synopsis "Kernel module tools")
+    (description "Kmod is a set of tools to handle common tasks with Linux
+kernel modules like insert, remove, list, check properties, resolve
+dependencies and aliases.
+
+These tools are designed on top of libkmod, a library that is shipped with
+kmod.  The aim is to be compatible with tools, configurations and indices
+from the module-init-tools project.")
+    (license license:gpl2+))) ; library under lgpl2.1+
+
+(define-public kmod
+  (package (inherit kmod-minimal)
     (name "kmod")
     (version "24")
     (source (origin
@@ -1946,15 +1973,14 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                (base32
                 "15xkkkzvca9flvkm48gkh8y8f13vlm3sl7nz9ydc7b3jy4fqs2v1"))
               (patches (search-patches "kmod-module-directory.patch"))))
-    (build-system gnu-build-system)
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (inputs
      `(("xz" ,xz)
        ("zlib" ,zlib)))
     (arguments
-     `(#:tests? #f ; FIXME: Investigate test failures
-       #:configure-flags '("--with-xz" "--with-zlib")
+     `(#:configure-flags '("--with-xz" "--with-zlib")
+       #:tests? #f ; FIXME: Investigate test failures
        #:phases (alist-cons-after
                  'install 'install-modprobe&co
                  (lambda* (#:key outputs #:allow-other-keys)
@@ -1964,18 +1990,9 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                                  (symlink "kmod"
                                           (string-append bin "/" tool)))
                                '("insmod" "rmmod" "lsmod" "modprobe"
-                                 "modinfo" "depmod"))))
-                 %standard-phases)))
-    (home-page "https://www.kernel.org/")
-    (synopsis "Kernel module tools")
-    (description "Kmod is a set of tools to handle common tasks with Linux
-kernel modules like insert, remove, list, check properties, resolve
-dependencies and aliases.
-
-These tools are designed on top of libkmod, a library that is shipped with
-kmod.  The aim is to be compatible with tools, configurations and indices
-from the module-init-tools project.")
-    (license license:gpl2+))) ; library under lgpl2.1+
+                                 "modinfo" "depmod"))
+                     #t))
+                 %standard-phases)))))
 
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
D
D
Danny Milosavljevic wrote on 27 Feb 2018 12:26
Download
[PATCH v4 2/7] gnu: Add kmod-minimal-static.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227112619.5071-3-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal/static): New variable.
* gnu/packages/patches/kmod-13-module-directory.patch: New file.
* gnu/local.mk: Add it.
---
gnu/local.mk | 1 +
gnu/packages/linux.scm | 44 ++++++++++++++++++++++
.../patches/kmod-13-module-directory.patch | 33 ++++++++++++++++
3 files changed, 78 insertions(+)
create mode 100644 gnu/packages/patches/kmod-13-module-directory.patch

Toggle diff (106 lines)
diff --git a/gnu/local.mk b/gnu/local.mk
index 21195f8c1..b1e3c878d 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -795,6 +795,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/kiki-makefile.patch			\
   %D%/packages/patches/kiki-missing-includes.patch		\
   %D%/packages/patches/kiki-portability-64bit.patch		\
+  %D%/packages/patches/kmod-13-module-directory.patch		\
   %D%/packages/patches/kmod-module-directory.patch		\
   %D%/packages/patches/kobodeluxe-paths.patch			\
   %D%/packages/patches/kobodeluxe-enemies-pipe-decl.patch	\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 1f8bf3050..b2e47f79a 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1994,6 +1994,50 @@ from the module-init-tools project.")
                      #t))
                  %standard-phases)))))
 
+(define-public kmod-minimal/static
+  (static-package
+   (package (inherit kmod-minimal)
+    (name "kmod-minimal-static")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (arguments
+     (substitute-keyword-arguments
+       (package-arguments (static-package kmod-minimal))
+       ((#:configure-flags flags ''())
+        `(cons* "--disable-manpages" "--disable-static" "--disable-shared" ,flags))
+       ((#:make-flags flags ''())
+        `(cons* "LDFLAGS=-all-static" ,flags))
+       ((#:phases phases '%standard-phases)
+        `(modify-phases ,phases
+          (delete 'install-license-files)
+          (add-after 'unpack 'patch-kmod
+           (lambda _
+             ;; Reduce size by 200 kiB.
+             (substitute* "tools/kmod.c"
+              (("[&]kmod_cmd_compat_lsmod,") "")
+              (("[&]kmod_cmd_compat_rmmod,") "")
+              (("[&]kmod_cmd_compat_insmod,") "")
+              (("[&]kmod_cmd_compat_modinfo,") ""))
+             #t))
+          (replace 'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let* ((out (assoc-ref outputs "out"))
+                     (bin (string-append out "/bin")))
+                (install-file "tools/kmod" bin)
+                (for-each
+                 (lambda (tool)
+                   (symlink "kmod" (string-append bin "/" tool)))
+                 '("modprobe" "depmod"))
+                #t))))))))))
+
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
   (package
diff --git a/gnu/packages/patches/kmod-13-module-directory.patch b/gnu/packages/patches/kmod-13-module-directory.patch
new file mode 100644
index 000000000..5ff2f8a60
--- /dev/null
+++ b/gnu/packages/patches/kmod-13-module-directory.patch
@@ -0,0 +1,33 @@
+This patch changes libkmod so it honors the 'LINUX_MODULE_DIRECTORY'
+environment variable, rather than looking for modules exclusively in
+/lib/modules.
+
+Patch by Shea Levy and Eelco Dolstra, from Nixpkgs; adjusted to
+use 'LINUX_MODULE_DIRECTORY' rather than 'MODULE_DIR' as the variable
+name.
+
+
+--- kmod-7/libkmod/libkmod.c	2012-03-15 08:19:16.750010226 -0400
++++ kmod-7/libkmod/libkmod.c	2012-04-04 15:21:29.532074313 -0400
+@@ -200,7 +200,7 @@
+ static char *get_kernel_release(const char *dirname)
+ {
+ 	struct utsname u;
+-	char *p;
++	char *p, *dirname_prefix;
+ 
+ 	if (dirname != NULL)
+ 		return path_make_absolute_cwd(dirname);
+@@ -208,7 +208,10 @@
+ 	if (uname(&u) < 0)
+ 		return NULL;
+ 
+-	if (asprintf(&p, "%s/%s", dirname_default_prefix, u.release) < 0)
++	if ((dirname_prefix = getenv("LINUX_MODULE_DIRECTORY")) == NULL)
++		dirname_prefix = dirname_default_prefix;
++
++	if (asprintf(&p, "%s/%s", dirname_prefix, u.release) < 0)
+ 		return NULL;
+ 
+ 	return p;
+
D
D
Danny Milosavljevic wrote on 27 Feb 2018 12:26
Download
[PATCH v4 0/7] Load Linux module only when supported hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227112619.5071-1-dannym@scratchpost.org
Download
Danny Milosavljevic (7):
gnu: kmod: Split off kmod-minimal.
gnu: Add kmod-minimal-static.
linux-initrd: Add kmod.
linux-boot: Load kernel modules only when the hardware is present.
vm: Allow qemu-image builder to load Linux kernel modules.
vm: Make the virtio-blk uniquely identifyable in /sys.
linux-boot: Call make-static-device-nodes much earlier.

gnu/build/linux-boot.scm | 43 ++++++++--
gnu/build/linux-initrd.scm | 12 ++-
gnu/build/vm.scm | 2 +-
gnu/local.mk | 1 +
gnu/packages/linux.scm | 91 ++++++++++++++++++----
.../patches/kmod-13-module-directory.patch | 33 ++++++++
gnu/services/base.scm | 11 ---
gnu/system/linux-initrd.scm | 50 +++++++++---
gnu/system/vm.scm | 34 ++++++--
9 files changed, 224 insertions(+), 53 deletions(-)
create mode 100644 gnu/packages/patches/kmod-13-module-directory.patch
D
D
Danny Milosavljevic wrote on 27 Feb 2018 12:26
Download
[PATCH v4 3/7] linux-initrd: Add kmod.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227112619.5071-4-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (raw-initrd): Add kmod.
(base-initrd): Add kmod.
(expression->initrd): Add kmod, linux-module-directory.
(flat-linux-module-directory): Add kmod; invoke depmod.
* gnu/build/linux-initrd.scm (build-initrd): Add kmod, linux-module-directory.
---
gnu/build/linux-initrd.scm | 12 +++++++++++-
gnu/system/linux-initrd.scm | 45 ++++++++++++++++++++++++++++++++++-----------
2 files changed, 45 insertions(+), 12 deletions(-)

Toggle diff (150 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..6356007df 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
+                       guile init kmod linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,16 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+    ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when kmod
+      (mkdir-p "sbin")
+      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 7170d1c0e..46ef055f0 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -59,6 +59,8 @@
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
+                             kmod
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -94,6 +96,8 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
+                        #:kmod #$kmod
+                        #:linux-module-directory #$linux-module-directory
                         ;; Copy everything INIT refers to into the initrd.
                         #:references-graphs '("closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
@@ -101,7 +105,7 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (gexp->derivation name builder
                     #:references-graphs `(("closure" ,init))))
 
-(define (flat-linux-module-directory linux modules)
+(define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
   (define build-exp
@@ -109,7 +113,7 @@ MODULES and taken from LINUX."
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
                        (srfi srfi-1)
                        (guix build utils)
                        (gnu build linux-modules))
@@ -138,13 +142,27 @@ MODULES and taken from LINUX."
                       (recursive-module-dependencies modules
                                                      #:lookup-module lookup))))
 
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
+          (define version
+            (match
+             (filter
+              (lambda (name)
+                (not (string-prefix? "." name)))
+              (scandir module-dir))
+             ((item) item)))
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (for-each (lambda (module)
+                        (format #t "copying '~a'...~%" module)
+                        (copy-file module
+                                   (string-append output "/"
+                                                  (basename module))))
+                      (delete-duplicates modules)))
+          (invoke (string-append #$kmod "/bin/depmod") "-a" "-b" #$output
+                  "-e"
+                  "-F" (string-append #$linux "/System.map")
+                  version)
+          #t)))
 
   (computed-file "linux-modules" build-exp))
 
@@ -152,6 +170,7 @@ MODULES and taken from LINUX."
                       #:key
                       (linux linux-libre)
                       (linux-modules '())
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       (helper-packages '())
                       qemu-networking?
@@ -185,7 +204,7 @@ upon error."
          mapped-devices))
 
   (define kodir
-    (flat-linux-module-directory linux linux-modules))
+    (flat-linux-module-directory linux linux-modules kmod))
 
   (expression->initrd
    (with-imported-modules (source-module-closure
@@ -223,6 +242,8 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:kmod kmod
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
@@ -245,6 +266,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?
                       volatile-root?
@@ -322,8 +344,9 @@ loaded at boot time in the order in which they appear."
   (raw-initrd file-systems
               #:linux linux
               #:linux-modules linux-modules
+              #:kmod kmod
               #:mapped-devices mapped-devices
-              #:helper-packages helper-packages
+              #:helper-packages (cons kmod helper-packages)
               #:qemu-networking? qemu-networking?
               #:volatile-root? volatile-root?
               #:on-error on-error))
D
D
Danny Milosavljevic wrote on 27 Feb 2018 12:26
Download
[PATCH v4 4/7] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227112619.5071-5-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 31 +++++++++++++++++++++++++++----
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 30 insertions(+), 5 deletions(-)

Toggle diff (64 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..6d00ea9be 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -473,6 +473,32 @@ upon error."
     (string-append linux-module-directory "/"
                    (ensure-dot-ko name)))
 
+  (define (load-kernel-modules)
+    "Examine /sys/devices to find out which modules to load and load them."
+    (define enter?
+      (const #t))
+    (define (down! path stat result)
+     ;; Note: modprobe mutates the tree starting with path.
+     (let ((modalias-name (string-append path "/modalias")))
+       (if (file-exists? modalias-name)
+           (let ((modalias
+                 (string-trim-right (call-with-input-file modalias-name
+                                                          read-string)
+                                    #\newline)))
+             (system* "/sbin/modprobe" "-q" "--" modalias))))
+       #t)
+    (define up
+      (const #t))
+    (define skip
+      (const #t))
+    (define leaf
+      (const #t))
+    (define (error name stat errno result)
+      (format (current-error-port) "warning: ~a: ~a~%"
+              name (strerror errno))
+      result)
+    (file-system-fold enter? leaf down! up skip error #t "/sys/devices"))
+
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
 
@@ -486,10 +512,7 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 46ef055f0..c8a9e4950 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -225,7 +225,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
D
D
Danny Milosavljevic wrote on 27 Feb 2018 12:26
Download
[PATCH v4 5/7] vm: Allow qemu-image builder to load Linux kernel modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227112619.5071-6-dannym@scratchpost.org
Download
* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
gnu/system/vm.scm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)

Toggle diff (74 lines)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd..b5a559012 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,20 +286,24 @@ INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
+   (with-imported-modules (source-module-closure '((gnu build activation)
+                                                   (gnu build bootloader)
                                                    (gnu build vm)
                                                    (guix build utils)))
      #~(begin
-         (use-modules (gnu build bootloader)
+         (use-modules (gnu build activation)
+                      (gnu build bootloader)
                       (gnu build vm)
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +317,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +387,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 
 ;;;
D
D
Danny Milosavljevic wrote on 27 Feb 2018 12:26
Download
[PATCH v4 6/7] vm: Make the virtio-blk uniquely identifyable in /sys.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227112619.5071-7-dannym@scratchpost.org
Download
* gnu/build/vm.scm (load-in-linux-vm): Set virtio-blk pci addr to 0x10.
* gnu/system/vm.scm (common-qemu-options): Set virtio-blk pci addr to 0x10.
---
gnu/build/vm.scm | 2 +-
gnu/system/vm.scm | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)

Toggle diff (27 lines)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..ebf9e9f6e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -154,7 +154,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-device" "virtio-blk,drive=myhd"
+                       `("-device" "virtio-blk-pci,addr=0x10,drive=myhd"
                          "-drive" ,(string-append "if=none,file=" output
                                                   ",format=" disk-image-format
                                                   ",id=myhd"))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index b5a559012..fdff64ed9 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -706,7 +706,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+     "-device" "virtio-blk-pci,addr=0x10,drive=myhd"
+     (format #f "-drive id=myhd,file=~a,if=none,cache=writeback,werror=report,readonly"
              #$image)))
 
 (define* (system-qemu-image/shared-store-script os
D
D
Danny Milosavljevic wrote on 27 Feb 2018 12:26
Download
[PATCH v4 7/7] linux-boot: Call make-static-device-nodes much earlier.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227112619.5071-8-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (expression->initrd): Store data files for
make-static-device-nodes.
* gnu/build/linux-boot.scm (make-static-device-nodes): Unexport.
(boot-system): Call make-static-device-nodes. Delete lookup-module.
* gnu/services/base.scm (udev-shepherd-service): Delete
make-static-device-nodes call.
---
gnu/build/linux-boot.scm | 14 +++++++++-----
gnu/services/base.scm | 11 -----------
gnu/system/linux-initrd.scm | 3 ++-
3 files changed, 11 insertions(+), 17 deletions(-)

Toggle diff (61 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 6d00ea9be..f0ac755f8 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -39,7 +39,6 @@
             find-long-option
             find-long-options
             make-essential-device-nodes
-            make-static-device-nodes
             configure-qemu-networking
 
             device-number
@@ -469,10 +468,6 @@ upon error."
              mounts)
         "ext4"))
 
-  (define (lookup-module name)
-    (string-append linux-module-directory "/"
-                   (ensure-dot-ko name)))
-
   (define (load-kernel-modules)
     "Examine /sys/devices to find out which modules to load and load them."
     (define enter?
@@ -512,6 +507,15 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
+       (let* ((kernel-release
+               (utsname:release (uname)))
+              (directory
+               (string-append linux-module-directory "/lib/modules/"
+                              kernel-release))
+              (old-umask (umask #o022)))
+         (make-static-device-nodes directory)
+         (umask old-umask))
+
        (load-kernel-modules)
 
        (when qemu-guest-networking?
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 69e211ffa..0cba1c66f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1857,17 +1857,6 @@ item of @var{packages}."
                     (setenv "EUDEV_RULES_DIRECTORY"
                             #$(file-append rules "/lib/udev/rules.d"))
 
-                    (let* ((kernel-release
-                            (utsname:release (uname)))
-                           (linux-module-directory
-                            (getenv "LINUX_MODULE_DIRECTORY"))
-                           (directory
-                            (string-append linux-module-directory "/"
-                                           kernel-release))
-                           (old-umask (umask #o022)))
-                      (make-static-device-nodes directory)
-                      (umask old-umask))
-
                     (let ((pid (primitive-fork)))
                       (case pid
                         ((0)
L
L
Ludovic Courtès wrote on 27 Feb 2018 15:26
Download
Re: [bug#30604] [PATCH v3 4/6] linux-boot: Load kernel modules only when the hardware is present.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)(address . 30604@debbugs.gnu.org)
87muzu33wh.fsf@gnu.org
Download
Hello,

Nice patch series!

Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (4 lines)
> * gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
> the hardware is present.
> * gnu/system/linux-initrd.scm (raw-initrd): Add imports.

[...]

Toggle quote (14 lines)
> + (define (load-kernel-modules)
> + "Examine /sys/devices to find out which modules to load and load them."
> + (define enter?
> + (const #t))
> + (define (down! path stat result)
> + ;; Note: modprobe mutates the tree starting with path.
> + (let ((modalias-name (string-append path "/modalias")))
> + (if (file-exists? modalias-name)
> + (let ((modalias
> + (string-trim-right (call-with-input-file modalias-name
> + read-string)
> + #\newline)))
> + (system* "/sbin/modprobe" "-q" "--" modalias))))

Can we build upon (gnu build linux-modules) to achieve this?

Hopefully the tools at
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30629#14 can help a bit.

Thanks,
Ludo’.
D
D
Danny Milosavljevic wrote on 27 Feb 2018 16:50
Download
[PATCH v5 1/7] gnu: kmod: Split off kmod-minimal.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227155051.1141-2-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal): New variable.
(kmod): Modify.
---
gnu/packages/linux.scm | 49 +++++++++++++++++++++++++++++++++----------------
1 file changed, 33 insertions(+), 16 deletions(-)

Toggle diff (81 lines)
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 238398e84..1f8bf3050 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1933,8 +1933,35 @@ for systems using the Linux kernel.  This includes commands such as
 to use Linux' inotify mechanism, which allows file accesses to be monitored.")
     (license license:gpl2+)))
 
-(define-public kmod
+(define kmod-minimal
   (package
+    (name "kmod-minimal")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f)) ; FIXME: Investigate test failures
+    (home-page "https://www.kernel.org/")
+    (synopsis "Kernel module tools")
+    (description "Kmod is a set of tools to handle common tasks with Linux
+kernel modules like insert, remove, list, check properties, resolve
+dependencies and aliases.
+
+These tools are designed on top of libkmod, a library that is shipped with
+kmod.  The aim is to be compatible with tools, configurations and indices
+from the module-init-tools project.")
+    (license license:gpl2+))) ; library under lgpl2.1+
+
+(define-public kmod
+  (package (inherit kmod-minimal)
     (name "kmod")
     (version "24")
     (source (origin
@@ -1946,15 +1973,14 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                (base32
                 "15xkkkzvca9flvkm48gkh8y8f13vlm3sl7nz9ydc7b3jy4fqs2v1"))
               (patches (search-patches "kmod-module-directory.patch"))))
-    (build-system gnu-build-system)
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (inputs
      `(("xz" ,xz)
        ("zlib" ,zlib)))
     (arguments
-     `(#:tests? #f ; FIXME: Investigate test failures
-       #:configure-flags '("--with-xz" "--with-zlib")
+     `(#:configure-flags '("--with-xz" "--with-zlib")
+       #:tests? #f ; FIXME: Investigate test failures
        #:phases (alist-cons-after
                  'install 'install-modprobe&co
                  (lambda* (#:key outputs #:allow-other-keys)
@@ -1964,18 +1990,9 @@ to use Linux' inotify mechanism, which allows file accesses to be monitored.")
                                  (symlink "kmod"
                                           (string-append bin "/" tool)))
                                '("insmod" "rmmod" "lsmod" "modprobe"
-                                 "modinfo" "depmod"))))
-                 %standard-phases)))
-    (home-page "https://www.kernel.org/")
-    (synopsis "Kernel module tools")
-    (description "Kmod is a set of tools to handle common tasks with Linux
-kernel modules like insert, remove, list, check properties, resolve
-dependencies and aliases.
-
-These tools are designed on top of libkmod, a library that is shipped with
-kmod.  The aim is to be compatible with tools, configurations and indices
-from the module-init-tools project.")
-    (license license:gpl2+))) ; library under lgpl2.1+
+                                 "modinfo" "depmod"))
+                     #t))
+                 %standard-phases)))))
 
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
D
D
Danny Milosavljevic wrote on 27 Feb 2018 16:50
Download
[PATCH v5 0/7] Load Linux module only when supported hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227155051.1141-1-dannym@scratchpost.org
Download
Danny Milosavljevic (7):
gnu: kmod: Split off kmod-minimal.
gnu: Add kmod-minimal-static.
linux-initrd: Add kmod.
linux-boot: Load kernel modules only when the hardware is present.
vm: Allow qemu-image builder to load Linux kernel modules.
vm: Make the virtio-blk is uniquely identifyable in /sys.
linux-boot: Call make-static-device-nodes much earlier.

gnu/build/linux-boot.scm | 42 ++++++++--
gnu/build/linux-initrd.scm | 12 ++-
gnu/build/vm.scm | 2 +-
gnu/local.mk | 1 +
gnu/packages/linux.scm | 91 ++++++++++++++++++----
.../patches/kmod-13-module-directory.patch | 33 ++++++++
gnu/system/linux-initrd.scm | 50 +++++++++---
gnu/system/vm.scm | 34 ++++++--
8 files changed, 224 insertions(+), 41 deletions(-)
create mode 100644 gnu/packages/patches/kmod-13-module-directory.patch
D
D
Danny Milosavljevic wrote on 27 Feb 2018 16:50
Download
[PATCH v5 2/7] gnu: Add kmod-minimal-static.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227155051.1141-3-dannym@scratchpost.org
Download
* gnu/packages/linux.scm (kmod-minimal/static): New variable.
* gnu/packages/patches/kmod-13-module-directory.patch: New file.
* gnu/local.mk: Add it.
---
gnu/local.mk | 1 +
gnu/packages/linux.scm | 44 ++++++++++++++++++++++
.../patches/kmod-13-module-directory.patch | 33 ++++++++++++++++
3 files changed, 78 insertions(+)
create mode 100644 gnu/packages/patches/kmod-13-module-directory.patch

Toggle diff (106 lines)
diff --git a/gnu/local.mk b/gnu/local.mk
index 21195f8c1..b1e3c878d 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -795,6 +795,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/kiki-makefile.patch			\
   %D%/packages/patches/kiki-missing-includes.patch		\
   %D%/packages/patches/kiki-portability-64bit.patch		\
+  %D%/packages/patches/kmod-13-module-directory.patch		\
   %D%/packages/patches/kmod-module-directory.patch		\
   %D%/packages/patches/kobodeluxe-paths.patch			\
   %D%/packages/patches/kobodeluxe-enemies-pipe-decl.patch	\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 1f8bf3050..b2e47f79a 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -1994,6 +1994,50 @@ from the module-init-tools project.")
                      #t))
                  %standard-phases)))))
 
+(define-public kmod-minimal/static
+  (static-package
+   (package (inherit kmod-minimal)
+    (name "kmod-minimal-static")
+    (version "13")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append "mirror://kernel.org/linux/utils/kernel/kmod/"
+                              "kmod-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0mkrklih0f33c3zc4mkk9qqbzy36r18mj9xffd4wi61gpamx6dkc"))
+              (patches (search-patches "kmod-13-module-directory.patch"))))
+    (arguments
+     (substitute-keyword-arguments
+       (package-arguments (static-package kmod-minimal))
+       ((#:configure-flags flags ''())
+        `(cons* "--disable-manpages" "--disable-static" "--disable-shared" ,flags))
+       ((#:make-flags flags ''())
+        `(cons* "LDFLAGS=-all-static" ,flags))
+       ((#:phases phases '%standard-phases)
+        `(modify-phases ,phases
+          (delete 'install-license-files)
+          (add-after 'unpack 'patch-kmod
+           (lambda _
+             ;; Reduce size by 200 kiB.
+             (substitute* "tools/kmod.c"
+              (("[&]kmod_cmd_compat_lsmod,") "")
+              (("[&]kmod_cmd_compat_rmmod,") "")
+              (("[&]kmod_cmd_compat_insmod,") "")
+              (("[&]kmod_cmd_compat_modinfo,") ""))
+             #t))
+          (replace 'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let* ((out (assoc-ref outputs "out"))
+                     (bin (string-append out "/bin")))
+                (install-file "tools/kmod" bin)
+                (for-each
+                 (lambda (tool)
+                   (symlink "kmod" (string-append bin "/" tool)))
+                 '("modprobe" "depmod"))
+                #t))))))))))
+
 (define-public eudev
   ;; The post-systemd fork, maintained by Gentoo.
   (package
diff --git a/gnu/packages/patches/kmod-13-module-directory.patch b/gnu/packages/patches/kmod-13-module-directory.patch
new file mode 100644
index 000000000..5ff2f8a60
--- /dev/null
+++ b/gnu/packages/patches/kmod-13-module-directory.patch
@@ -0,0 +1,33 @@
+This patch changes libkmod so it honors the 'LINUX_MODULE_DIRECTORY'
+environment variable, rather than looking for modules exclusively in
+/lib/modules.
+
+Patch by Shea Levy and Eelco Dolstra, from Nixpkgs; adjusted to
+use 'LINUX_MODULE_DIRECTORY' rather than 'MODULE_DIR' as the variable
+name.
+
+
+--- kmod-7/libkmod/libkmod.c	2012-03-15 08:19:16.750010226 -0400
++++ kmod-7/libkmod/libkmod.c	2012-04-04 15:21:29.532074313 -0400
+@@ -200,7 +200,7 @@
+ static char *get_kernel_release(const char *dirname)
+ {
+ 	struct utsname u;
+-	char *p;
++	char *p, *dirname_prefix;
+ 
+ 	if (dirname != NULL)
+ 		return path_make_absolute_cwd(dirname);
+@@ -208,7 +208,10 @@
+ 	if (uname(&u) < 0)
+ 		return NULL;
+ 
+-	if (asprintf(&p, "%s/%s", dirname_default_prefix, u.release) < 0)
++	if ((dirname_prefix = getenv("LINUX_MODULE_DIRECTORY")) == NULL)
++		dirname_prefix = dirname_default_prefix;
++
++	if (asprintf(&p, "%s/%s", dirname_prefix, u.release) < 0)
+ 		return NULL;
+ 
+ 	return p;
+
D
D
Danny Milosavljevic wrote on 27 Feb 2018 16:50
Download
[PATCH v5 3/7] linux-initrd: Add kmod.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227155051.1141-4-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (raw-initrd): Add kmod.
(base-initrd): Add kmod.
(expression->initrd): Add kmod, linux-module-directory.
(flat-linux-module-directory): Add kmod; invoke depmod.
* gnu/build/linux-initrd.scm (build-initrd): Add kmod, linux-module-directory.
---
gnu/build/linux-initrd.scm | 12 +++++++++++-
gnu/system/linux-initrd.scm | 45 ++++++++++++++++++++++++++++++++++-----------
2 files changed, 45 insertions(+), 12 deletions(-)

Toggle diff (150 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..6356007df 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
+                       guile init kmod linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,16 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+    ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when kmod
+      (mkdir-p "sbin")
+      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 7170d1c0e..46ef055f0 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -59,6 +59,8 @@
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
+                             kmod
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -94,6 +96,8 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
+                        #:kmod #$kmod
+                        #:linux-module-directory #$linux-module-directory
                         ;; Copy everything INIT refers to into the initrd.
                         #:references-graphs '("closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
@@ -101,7 +105,7 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (gexp->derivation name builder
                     #:references-graphs `(("closure" ,init))))
 
-(define (flat-linux-module-directory linux modules)
+(define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
   (define build-exp
@@ -109,7 +113,7 @@ MODULES and taken from LINUX."
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
                        (srfi srfi-1)
                        (guix build utils)
                        (gnu build linux-modules))
@@ -138,13 +142,27 @@ MODULES and taken from LINUX."
                       (recursive-module-dependencies modules
                                                      #:lookup-module lookup))))
 
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
+          (define version
+            (match
+             (filter
+              (lambda (name)
+                (not (string-prefix? "." name)))
+              (scandir module-dir))
+             ((item) item)))
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (for-each (lambda (module)
+                        (format #t "copying '~a'...~%" module)
+                        (copy-file module
+                                   (string-append output "/"
+                                                  (basename module))))
+                      (delete-duplicates modules)))
+          (invoke (string-append #$kmod "/bin/depmod") "-a" "-b" #$output
+                  "-e"
+                  "-F" (string-append #$linux "/System.map")
+                  version)
+          #t)))
 
   (computed-file "linux-modules" build-exp))
 
@@ -152,6 +170,7 @@ MODULES and taken from LINUX."
                       #:key
                       (linux linux-libre)
                       (linux-modules '())
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       (helper-packages '())
                       qemu-networking?
@@ -185,7 +204,7 @@ upon error."
          mapped-devices))
 
   (define kodir
-    (flat-linux-module-directory linux linux-modules))
+    (flat-linux-module-directory linux linux-modules kmod))
 
   (expression->initrd
    (with-imported-modules (source-module-closure
@@ -223,6 +242,8 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:kmod kmod
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
@@ -245,6 +266,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?
                       volatile-root?
@@ -322,8 +344,9 @@ loaded at boot time in the order in which they appear."
   (raw-initrd file-systems
               #:linux linux
               #:linux-modules linux-modules
+              #:kmod kmod
               #:mapped-devices mapped-devices
-              #:helper-packages helper-packages
+              #:helper-packages (cons kmod helper-packages)
               #:qemu-networking? qemu-networking?
               #:volatile-root? volatile-root?
               #:on-error on-error))
D
D
Danny Milosavljevic wrote on 27 Feb 2018 16:50
Download
[PATCH v5 4/7] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227155051.1141-5-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 31 +++++++++++++++++++++++++++----
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 30 insertions(+), 5 deletions(-)

Toggle diff (64 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..6d00ea9be 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -473,6 +473,32 @@ upon error."
     (string-append linux-module-directory "/"
                    (ensure-dot-ko name)))
 
+  (define (load-kernel-modules)
+    "Examine /sys/devices to find out which modules to load and load them."
+    (define enter?
+      (const #t))
+    (define (down! path stat result)
+     ;; Note: modprobe mutates the tree starting with path.
+     (let ((modalias-name (string-append path "/modalias")))
+       (if (file-exists? modalias-name)
+           (let ((modalias
+                 (string-trim-right (call-with-input-file modalias-name
+                                                          read-string)
+                                    #\newline)))
+             (system* "/sbin/modprobe" "-q" "--" modalias))))
+       #t)
+    (define up
+      (const #t))
+    (define skip
+      (const #t))
+    (define leaf
+      (const #t))
+    (define (error name stat errno result)
+      (format (current-error-port) "warning: ~a: ~a~%"
+              name (strerror errno))
+      result)
+    (file-system-fold enter? leaf down! up skip error #t "/sys/devices"))
+
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
 
@@ -486,10 +512,7 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 46ef055f0..c8a9e4950 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -225,7 +225,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
D
D
Danny Milosavljevic wrote on 27 Feb 2018 16:50
Download
[PATCH v5 5/7] vm: Allow qemu-image builder to load Linux kernel modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227155051.1141-6-dannym@scratchpost.org
Download
* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
gnu/system/vm.scm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)

Toggle diff (74 lines)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd..b5a559012 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,20 +286,24 @@ INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
+   (with-imported-modules (source-module-closure '((gnu build activation)
+                                                   (gnu build bootloader)
                                                    (gnu build vm)
                                                    (guix build utils)))
      #~(begin
-         (use-modules (gnu build bootloader)
+         (use-modules (gnu build activation)
+                      (gnu build bootloader)
                       (gnu build vm)
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +317,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +387,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 
 ;;;
D
D
Danny Milosavljevic wrote on 27 Feb 2018 16:50
Download
[PATCH v5 6/7] vm: Make the virtio-blk is uniquely identifyable in /sys.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227155051.1141-7-dannym@scratchpost.org
Download
* gnu/build/vm.scm (load-in-linux-vm): Set virtio-blk pci addr to 0x10.
* gnu/system/vm.scm (common-qemu-options): Set virtio-blk pci addr to 0x10.
---
gnu/build/vm.scm | 2 +-
gnu/system/vm.scm | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)

Toggle diff (27 lines)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..ebf9e9f6e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -154,7 +154,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-device" "virtio-blk,drive=myhd"
+                       `("-device" "virtio-blk-pci,addr=0x10,drive=myhd"
                          "-drive" ,(string-append "if=none,file=" output
                                                   ",format=" disk-image-format
                                                   ",id=myhd"))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index b5a559012..fdff64ed9 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -706,7 +706,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+     "-device" "virtio-blk-pci,addr=0x10,drive=myhd"
+     (format #f "-drive id=myhd,file=~a,if=none,cache=writeback,werror=report,readonly"
              #$image)))
 
 (define* (system-qemu-image/shared-store-script os
D
D
Danny Milosavljevic wrote on 27 Feb 2018 16:50
Download
[PATCH v5 7/7] linux-boot: Call make-static-device-nodes much earlier.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180227155051.1141-8-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (expression->initrd): Store data files for
make-static-device-nodes.
* gnu/build/linux-boot.scm (boot-system): Call make-static-device-nodes.
Delete lookup-module.
---
gnu/build/linux-boot.scm | 13 +++++++++----
gnu/system/linux-initrd.scm | 3 ++-
2 files changed, 11 insertions(+), 5 deletions(-)

Toggle diff (31 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 6d00ea9be..1b16f267a 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -469,10 +469,6 @@ upon error."
              mounts)
         "ext4"))
 
-  (define (lookup-module name)
-    (string-append linux-module-directory "/"
-                   (ensure-dot-ko name)))
-
   (define (load-kernel-modules)
     "Examine /sys/devices to find out which modules to load and load them."
     (define enter?
@@ -512,6 +508,15 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
+       (let* ((kernel-release
+               (utsname:release (uname)))
+              (directory
+               (string-append linux-module-directory "/lib/modules/"
+                              kernel-release))
+              (old-umask (umask #o022)))
+         (make-static-device-nodes directory)
+         (umask old-umask))
+
        (load-kernel-modules)
 
        (when qemu-guest-networking?
D
D
Danny Milosavljevic wrote on 2 Mar 2018 15:16
Download
[PATCH v6 0/6] Load Linux module only when supported hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302141606.10669-1-dannym@scratchpost.org
Download
Danny Milosavljevic (6):
linux-modules: Add module-aliases.
linux-modules: Add install-modules.
linux-boot: Load kernel modules only when the hardware is present.
vm: Allow qemu-image builder to load Linux kernel modules.
vm: Make the virtio-blk uniquely identifiable in /sys.
linux-initrd: Provide modprobe to the initrd.

gnu/build/linux-boot.scm | 42 ++++++++++++++++++----
gnu/build/linux-initrd.scm | 13 ++++++-
gnu/build/linux-modules.scm | 61 +++++++++++++++++++++++++++++++
gnu/build/vm.scm | 2 +-
gnu/system/linux-initrd.scm | 88 +++++++++++++++++++++++++++++++++++++++------
gnu/system/vm.scm | 34 +++++++++++++++---
6 files changed, 216 insertions(+), 24 deletions(-)
D
D
Danny Milosavljevic wrote on 2 Mar 2018 15:17
Download
[PATCH v6 1/6] linux-modules: Add module-aliases.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302141720.10720-1-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (module-aliases): New variable.
---
gnu/build/linux-modules.scm | 9 +++++++++
1 file changed, 9 insertions(+)

Toggle diff (26 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 4a6d4ff08..364339df9 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -30,6 +30,7 @@
   #:use-module (ice-9 rdelim)
   #:export (dot-ko
             ensure-dot-ko
+            module-aliases
             module-dependencies
             recursive-module-dependencies
             modules-loaded
@@ -95,6 +96,14 @@ contains module names, not actual file names."
       (('depends . what)
        (string-tokenize what %not-comma)))))
 
+(define (module-aliases file)
+  "Return the list of aliases for FILE."
+  (let ((info (modinfo-section-contents file)))
+    (filter-map (match-lambda
+                 (('alias . value)
+                  value)
+                 (_ #f)) (modinfo-section-contents file))))
+
 (define dot-ko
   (cut string-append <> ".ko"))
D
D
Danny Milosavljevic wrote on 2 Mar 2018 15:17
Download
[PATCH v6 2/6] linux-modules: Add install-modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302141720.10720-2-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (install-modules): New procedure.
(%not-dash): New variable.
---
gnu/build/linux-modules.scm | 52 +++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 52 insertions(+)

Toggle diff (68 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 364339df9..af217c974 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -36,6 +36,7 @@
             modules-loaded
             module-loaded?
             load-linux-module*
+            install-module-files
 
             current-module-debugging-port
 
@@ -379,4 +380,55 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                       module)))
               known-aliases))
 
+(define %not-dash
+  (char-set-complement (char-set #\-)))
+
+(define (install-module-files module-files output)
+  "Install MODULE-FILES to OUTPUT.
+Precondition: OUTPUT is an empty directory."
+  (let ((aliases
+         (map (lambda (module-file-name)
+                (format #t "copying '~a'...~%" module-file-name)
+                (copy-file module-file-name
+                           (string-append output "/"
+                                          (basename module-file-name)))
+                `(,(file-name->module-name module-file-name) .
+                  ,(module-aliases module-file-name)))
+              (sort module-files string<))))
+    (call-with-output-file (string-append output "/modules.alias")
+      (lambda (port)
+        (format port
+                "# Aliases extracted from modules themselves.\n")
+        (for-each (match-lambda ((module . aliases)
+                                 (for-each (lambda (alias)
+                                             (format port "alias ~a ~a\n" alias
+                                                     module))
+                                           aliases)))
+                  aliases)))
+    (call-with-output-file (string-append output "/modules.devname")
+      (lambda (port)
+        (format port
+                "# Device nodes to trigger on-demand module loading.\n")
+        (let* ((aliases (append-map (match-lambda
+                                     ((module . aliases) aliases))
+                                    aliases))
+               (devname #f))
+          ;; Note: there's only one devname and then only one (char-major|block-major).
+          (for-each
+           (match-lambda
+            (((? (cut string-prefix? "devname:" <>) alias) . value)
+             (set! devname (string-drop value (string-length "devname:"))))
+            (((? (cut string-prefix? "char-major-" <>) alias) . value)
+             (let ((parts (string-tokenize %not-dash)))
+               (match parts
+                      ((a b major minor)
+                       (format port "~a ~a ~a:~a\n" devname "c" major minor)))))
+            (((? (cut string-prefix? "block-major-" <>) alias) . value)
+             (let ((parts (string-tokenize %not-dash)))
+               (match parts
+                      ((a b major minor)
+                       (format port "~a ~a ~a:~a\n" devname "b" major minor)))))
+            (_ #f))
+           aliases))))))
+
 ;;; linux-modules.scm ends here
D
D
Danny Milosavljevic wrote on 2 Mar 2018 15:17
Download
[PATCH v6 3/6] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302141720.10720-3-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
(lookup-module): Delete procedure.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 42 +++++++++++++++++++++++++++++++++++-------
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 38 insertions(+), 8 deletions(-)

Toggle diff (75 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..1b16f267a 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -469,9 +469,31 @@ upon error."
              mounts)
         "ext4"))
 
-  (define (lookup-module name)
-    (string-append linux-module-directory "/"
-                   (ensure-dot-ko name)))
+  (define (load-kernel-modules)
+    "Examine /sys/devices to find out which modules to load and load them."
+    (define enter?
+      (const #t))
+    (define (down! path stat result)
+     ;; Note: modprobe mutates the tree starting with path.
+     (let ((modalias-name (string-append path "/modalias")))
+       (if (file-exists? modalias-name)
+           (let ((modalias
+                 (string-trim-right (call-with-input-file modalias-name
+                                                          read-string)
+                                    #\newline)))
+             (system* "/sbin/modprobe" "-q" "--" modalias))))
+       #t)
+    (define up
+      (const #t))
+    (define skip
+      (const #t))
+    (define leaf
+      (const #t))
+    (define (error name stat errno result)
+      (format (current-error-port) "warning: ~a: ~a~%"
+              name (strerror errno))
+      result)
+    (file-system-fold enter? leaf down! up skip error #t "/sys/devices"))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
@@ -486,10 +508,16 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (let* ((kernel-release
+               (utsname:release (uname)))
+              (directory
+               (string-append linux-module-directory "/lib/modules/"
+                              kernel-release))
+              (old-umask (umask #o022)))
+         (make-static-device-nodes directory)
+         (umask old-umask))
+
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index e7f97bb88..b50d3ff80 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -208,7 +208,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
D
D
Danny Milosavljevic wrote on 2 Mar 2018 15:17
Download
[PATCH v6 4/6] vm: Allow qemu-image builder to load Linux kernel modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302141720.10720-4-dannym@scratchpost.org
Download
* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
gnu/system/vm.scm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)

Toggle diff (74 lines)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd..b5a559012 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,20 +286,24 @@ INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
+   (with-imported-modules (source-module-closure '((gnu build activation)
+                                                   (gnu build bootloader)
                                                    (gnu build vm)
                                                    (guix build utils)))
      #~(begin
-         (use-modules (gnu build bootloader)
+         (use-modules (gnu build activation)
+                      (gnu build bootloader)
                       (gnu build vm)
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +317,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +387,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 
 ;;;
D
D
Danny Milosavljevic wrote on 2 Mar 2018 15:17
Download
[PATCH v6 5/6] vm: Make the virtio-blk uniquely identifiable in /sys.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302141720.10720-5-dannym@scratchpost.org
Download
* gnu/build/vm.scm (load-in-linux-vm): Set virtio-blk pci addr to 0x10.
* gnu/system/vm.scm (common-qemu-options): Set virtio-blk pci addr to 0x10.
---
gnu/build/vm.scm | 2 +-
gnu/system/vm.scm | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)

Toggle diff (27 lines)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..ebf9e9f6e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -154,7 +154,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-device" "virtio-blk,drive=myhd"
+                       `("-device" "virtio-blk-pci,addr=0x10,drive=myhd"
                          "-drive" ,(string-append "if=none,file=" output
                                                   ",format=" disk-image-format
                                                   ",id=myhd"))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index b5a559012..fdff64ed9 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -706,7 +706,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+     "-device" "virtio-blk-pci,addr=0x10,drive=myhd"
+     (format #f "-drive id=myhd,file=~a,if=none,cache=writeback,werror=report,readonly"
              #$image)))
 
 (define* (system-qemu-image/shared-store-script os
D
D
Danny Milosavljevic wrote on 2 Mar 2018 15:17
Download
[PATCH v6 6/6] linux-initrd: Provide modprobe to the initrd.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302141720.10720-6-dannym@scratchpost.org
Download
* gnu/build/linux-initrd.scm (build-initrd): Provide modprobe and the
linux modules to the initrd.
* gnu/system/linux-initrd.scm (%modprobe): New procedure.
(expression->initrd): Use it. Add linux-module-directory.
(raw-initrd): Pass linux-module-directory.
---
gnu/build/linux-initrd.scm | 13 ++++++-
gnu/system/linux-initrd.scm | 84 ++++++++++++++++++++++++++++++++++++++++-----
2 files changed, 87 insertions(+), 10 deletions(-)

Toggle diff (162 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..d4cb5e2d8 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
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,17 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when modprobe
+      (mkdir-p "sbin")
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index b50d3ff80..a69497ff8 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,11 +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)
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -73,6 +135,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)))
@@ -96,12 +161,17 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        #:modprobe #$modprobe
+                        #:linux-module-directory #$linux-module-directory
+                        ;; 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)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -141,12 +211,7 @@ MODULES and taken from LINUX."
                                                      #:lookup-module lookup))))
 
           (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
+          (install-module-files (delete-duplicates modules) #$output))))
 
   (computed-file "linux-modules" build-exp))
 
@@ -227,6 +292,7 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
D
D
Danny Milosavljevic wrote on 2 Mar 2018 16:34
Download
[PATCH v7 0/6] Load Linux module only when supported hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302153408.14091-1-dannym@scratchpost.org
Download
Danny Milosavljevic (6):
linux-modules: Add module-aliases.
linux-modules: Add install-modules.
linux-boot: Load kernel modules only when the hardware is present.
vm: Allow qemu-image builder to load Linux kernel modules.
vm: Make the virtio-blk uniquely identifiable in /sys.
linux-initrd: Provide modprobe to the initrd.

gnu/build/linux-boot.scm | 42 +++++++++++++++---
gnu/build/linux-initrd.scm | 13 +++++-
gnu/build/linux-modules.scm | 61 ++++++++++++++++++++++++++
gnu/build/vm.scm | 2 +-
gnu/system/linux-initrd.scm | 103 ++++++++++++++++++++++++++++++++++++++------
gnu/system/vm.scm | 34 ++++++++++++---
6 files changed, 228 insertions(+), 27 deletions(-)
D
D
Danny Milosavljevic wrote on 2 Mar 2018 16:34
Download
[PATCH v7 1/6] linux-modules: Add module-aliases.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302153408.14091-2-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (module-aliases): New variable.
---
gnu/build/linux-modules.scm | 9 +++++++++
1 file changed, 9 insertions(+)

Toggle diff (26 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 4a6d4ff08..364339df9 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -30,6 +30,7 @@
   #:use-module (ice-9 rdelim)
   #:export (dot-ko
             ensure-dot-ko
+            module-aliases
             module-dependencies
             recursive-module-dependencies
             modules-loaded
@@ -95,6 +96,14 @@ contains module names, not actual file names."
       (('depends . what)
        (string-tokenize what %not-comma)))))
 
+(define (module-aliases file)
+  "Return the list of aliases for FILE."
+  (let ((info (modinfo-section-contents file)))
+    (filter-map (match-lambda
+                 (('alias . value)
+                  value)
+                 (_ #f)) (modinfo-section-contents file))))
+
 (define dot-ko
   (cut string-append <> ".ko"))
D
D
Danny Milosavljevic wrote on 2 Mar 2018 16:34
Download
[PATCH v7 2/6] linux-modules: Add install-modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302153408.14091-3-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (install-modules): New procedure.
(%not-dash): New variable.
---
gnu/build/linux-modules.scm | 52 +++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 52 insertions(+)

Toggle diff (68 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 364339df9..af217c974 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -36,6 +36,7 @@
             modules-loaded
             module-loaded?
             load-linux-module*
+            install-module-files
 
             current-module-debugging-port
 
@@ -379,4 +380,55 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                       module)))
               known-aliases))
 
+(define %not-dash
+  (char-set-complement (char-set #\-)))
+
+(define (install-module-files module-files output)
+  "Install MODULE-FILES to OUTPUT.
+Precondition: OUTPUT is an empty directory."
+  (let ((aliases
+         (map (lambda (module-file-name)
+                (format #t "copying '~a'...~%" module-file-name)
+                (copy-file module-file-name
+                           (string-append output "/"
+                                          (basename module-file-name)))
+                `(,(file-name->module-name module-file-name) .
+                  ,(module-aliases module-file-name)))
+              (sort module-files string<))))
+    (call-with-output-file (string-append output "/modules.alias")
+      (lambda (port)
+        (format port
+                "# Aliases extracted from modules themselves.\n")
+        (for-each (match-lambda ((module . aliases)
+                                 (for-each (lambda (alias)
+                                             (format port "alias ~a ~a\n" alias
+                                                     module))
+                                           aliases)))
+                  aliases)))
+    (call-with-output-file (string-append output "/modules.devname")
+      (lambda (port)
+        (format port
+                "# Device nodes to trigger on-demand module loading.\n")
+        (let* ((aliases (append-map (match-lambda
+                                     ((module . aliases) aliases))
+                                    aliases))
+               (devname #f))
+          ;; Note: there's only one devname and then only one (char-major|block-major).
+          (for-each
+           (match-lambda
+            (((? (cut string-prefix? "devname:" <>) alias) . value)
+             (set! devname (string-drop value (string-length "devname:"))))
+            (((? (cut string-prefix? "char-major-" <>) alias) . value)
+             (let ((parts (string-tokenize %not-dash)))
+               (match parts
+                      ((a b major minor)
+                       (format port "~a ~a ~a:~a\n" devname "c" major minor)))))
+            (((? (cut string-prefix? "block-major-" <>) alias) . value)
+             (let ((parts (string-tokenize %not-dash)))
+               (match parts
+                      ((a b major minor)
+                       (format port "~a ~a ~a:~a\n" devname "b" major minor)))))
+            (_ #f))
+           aliases))))))
+
 ;;; linux-modules.scm ends here
D
D
Danny Milosavljevic wrote on 2 Mar 2018 16:34
Download
[PATCH v7 3/6] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302153408.14091-4-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
(lookup-module): Delete procedure.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 42 +++++++++++++++++++++++++++++++++++-------
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 38 insertions(+), 8 deletions(-)

Toggle diff (75 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..1b16f267a 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -469,9 +469,31 @@ upon error."
              mounts)
         "ext4"))
 
-  (define (lookup-module name)
-    (string-append linux-module-directory "/"
-                   (ensure-dot-ko name)))
+  (define (load-kernel-modules)
+    "Examine /sys/devices to find out which modules to load and load them."
+    (define enter?
+      (const #t))
+    (define (down! path stat result)
+     ;; Note: modprobe mutates the tree starting with path.
+     (let ((modalias-name (string-append path "/modalias")))
+       (if (file-exists? modalias-name)
+           (let ((modalias
+                 (string-trim-right (call-with-input-file modalias-name
+                                                          read-string)
+                                    #\newline)))
+             (system* "/sbin/modprobe" "-q" "--" modalias))))
+       #t)
+    (define up
+      (const #t))
+    (define skip
+      (const #t))
+    (define leaf
+      (const #t))
+    (define (error name stat errno result)
+      (format (current-error-port) "warning: ~a: ~a~%"
+              name (strerror errno))
+      result)
+    (file-system-fold enter? leaf down! up skip error #t "/sys/devices"))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
@@ -486,10 +508,16 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (let* ((kernel-release
+               (utsname:release (uname)))
+              (directory
+               (string-append linux-module-directory "/lib/modules/"
+                              kernel-release))
+              (old-umask (umask #o022)))
+         (make-static-device-nodes directory)
+         (umask old-umask))
+
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index e7f97bb88..b50d3ff80 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -208,7 +208,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
D
D
Danny Milosavljevic wrote on 2 Mar 2018 16:34
Download
[PATCH v7 4/6] vm: Allow qemu-image builder to load Linux kernel modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302153408.14091-5-dannym@scratchpost.org
Download
* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
gnu/system/vm.scm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)

Toggle diff (74 lines)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd..b5a559012 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,20 +286,24 @@ INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
+   (with-imported-modules (source-module-closure '((gnu build activation)
+                                                   (gnu build bootloader)
                                                    (gnu build vm)
                                                    (guix build utils)))
      #~(begin
-         (use-modules (gnu build bootloader)
+         (use-modules (gnu build activation)
+                      (gnu build bootloader)
                       (gnu build vm)
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +317,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +387,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 
 ;;;
D
D
Danny Milosavljevic wrote on 2 Mar 2018 16:34
Download
[PATCH v7 5/6] vm: Make the virtio-blk uniquely identifiable in /sys.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302153408.14091-6-dannym@scratchpost.org
Download
* gnu/build/vm.scm (load-in-linux-vm): Set virtio-blk pci addr to 0x10.
* gnu/system/vm.scm (common-qemu-options): Set virtio-blk pci addr to 0x10.
---
gnu/build/vm.scm | 2 +-
gnu/system/vm.scm | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)

Toggle diff (27 lines)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..ebf9e9f6e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -154,7 +154,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-device" "virtio-blk,drive=myhd"
+                       `("-device" "virtio-blk-pci,addr=0x10,drive=myhd"
                          "-drive" ,(string-append "if=none,file=" output
                                                   ",format=" disk-image-format
                                                   ",id=myhd"))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index b5a559012..fdff64ed9 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -706,7 +706,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+     "-device" "virtio-blk-pci,addr=0x10,drive=myhd"
+     (format #f "-drive id=myhd,file=~a,if=none,cache=writeback,werror=report,readonly"
              #$image)))
 
 (define* (system-qemu-image/shared-store-script os
D
D
Danny Milosavljevic wrote on 2 Mar 2018 16:34
Download
[PATCH v7 6/6] linux-initrd: Provide modprobe to the initrd.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180302153408.14091-7-dannym@scratchpost.org
Download
* gnu/build/linux-initrd.scm (build-initrd): Provide modprobe and the
linux modules to the initrd.
* gnu/system/linux-initrd.scm (%modprobe): New procedure.
(expression->initrd): Use it. Add linux-module-directory.
(raw-initrd): Pass linux-module-directory.
---
gnu/build/linux-initrd.scm | 13 +++++-
gnu/system/linux-initrd.scm | 99 +++++++++++++++++++++++++++++++++++++++------
2 files changed, 99 insertions(+), 13 deletions(-)

Toggle diff (184 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..d4cb5e2d8 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
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,17 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when modprobe
+      (mkdir-p "sbin")
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index b50d3ff80..8050ac47e 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,11 +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)
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -73,6 +135,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)))
@@ -96,12 +161,17 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        #:modprobe #$modprobe
+                        #:linux-module-directory #$linux-module-directory
+                        ;; 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)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -111,7 +181,7 @@ MODULES and taken from LINUX."
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
                        (srfi srfi-1)
                        (guix build utils)
                        (gnu build linux-modules))
@@ -140,14 +210,18 @@ MODULES and taken from LINUX."
                       (recursive-module-dependencies modules
                                                      #:lookup-module lookup))))
 
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
-
+          (define version
+            (match
+             (filter
+              (lambda (name)
+                (not (string-prefix? "." name)))
+              (scandir module-dir))
+             ((item) item)))
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (install-module-files (delete-duplicates modules) output))
+          #t)))
   (computed-file "linux-modules" build-exp))
 
 (define* (raw-initrd file-systems
@@ -227,6 +301,7 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
D
D
Danny Milosavljevic wrote on 2 Mar 2018 17:47
Download
Re: [PATCH v7 3/6] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)
20180302174711.4018dc49@scratchpost.org
Download
Toggle quote (8 lines)
> + (define (load-kernel-modules)
> + "Examine /sys/devices to find out which modules to load and load them."
> + (define enter?
> + (const #t))
> + (define (down! path stat result)
> + ;; Note: modprobe mutates the tree starting with path.
> + (let ((modalias-name (string-append path "/modalias")))

I should rename "path" to "directory".
D
D
Danny Milosavljevic wrote on 2 Mar 2018 17:47
Download
Re: [PATCH v7 1/6] linux-modules: Add module-aliases.
(address . 30604@debbugs.gnu.org)
20180302174751.741d5dd3@scratchpost.org
Download
Toggle quote (1 lines)
> + "Return the list of aliases for FILE."
^^^ replace by "in"
D
D
Danny Milosavljevic wrote on 3 Mar 2018 14:55
Download
[PATCH v8 0/7] Load Linux module only when supported hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180303135533.6112-1-dannym@scratchpost.org
Download
Danny Milosavljevic (7):
linux-modules: Add module-aliases.
linux-modules: Add install-modules.
linux-boot: Load kernel modules only when the hardware is present.
vm: Allow qemu-image builder to load Linux kernel modules.
vm: Make the virtio-blk uniquely identifiable in /sys.
linux-initrd: Provide modprobe to the initrd.
linux-initrd: Factorize %modprobe and flat-linux-module-directory.

gnu/build/linux-boot.scm | 42 ++++++++++++---
gnu/build/linux-initrd.scm | 13 ++++-
gnu/build/linux-modules.scm | 115 +++++++++++++++++++++++++++++++++++++++++
gnu/build/vm.scm | 2 +-
gnu/system/linux-initrd.scm | 121 ++++++++++++++++++++++++++++++++------------
gnu/system/vm.scm | 34 +++++++++++--
6 files changed, 281 insertions(+), 46 deletions(-)
D
D
Danny Milosavljevic wrote on 3 Mar 2018 14:55
Download
[PATCH v8 1/7] linux-modules: Add module-aliases.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180303135533.6112-2-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (module-aliases): New variable.
---
gnu/build/linux-modules.scm | 9 +++++++++
1 file changed, 9 insertions(+)

Toggle diff (26 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 4a6d4ff08..364339df9 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -30,6 +30,7 @@
   #:use-module (ice-9 rdelim)
   #:export (dot-ko
             ensure-dot-ko
+            module-aliases
             module-dependencies
             recursive-module-dependencies
             modules-loaded
@@ -95,6 +96,14 @@ contains module names, not actual file names."
       (('depends . what)
        (string-tokenize what %not-comma)))))
 
+(define (module-aliases file)
+  "Return the list of aliases of module FILE."
+  (let ((info (modinfo-section-contents file)))
+    (filter-map (match-lambda
+                 (('alias . value)
+                  value)
+                 (_ #f)) (modinfo-section-contents file))))
+
 (define dot-ko
   (cut string-append <> ".ko"))
D
D
Danny Milosavljevic wrote on 3 Mar 2018 14:55
Download
[PATCH v8 2/7] linux-modules: Add install-modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180303135533.6112-3-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (install-modules): New procedure.
(%not-dash): New variable.
---
gnu/build/linux-modules.scm | 52 +++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 52 insertions(+)

Toggle diff (68 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 364339df9..af217c974 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -36,6 +36,7 @@
             modules-loaded
             module-loaded?
             load-linux-module*
+            install-module-files
 
             current-module-debugging-port
 
@@ -379,4 +380,55 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                       module)))
               known-aliases))
 
+(define %not-dash
+  (char-set-complement (char-set #\-)))
+
+(define (install-module-files module-files output)
+  "Install MODULE-FILES to OUTPUT.
+Precondition: OUTPUT is an empty directory."
+  (let ((aliases
+         (map (lambda (module-file-name)
+                (format #t "copying '~a'...~%" module-file-name)
+                (copy-file module-file-name
+                           (string-append output "/"
+                                          (basename module-file-name)))
+                `(,(file-name->module-name module-file-name) .
+                  ,(module-aliases module-file-name)))
+              (sort module-files string<))))
+    (call-with-output-file (string-append output "/modules.alias")
+      (lambda (port)
+        (format port
+                "# Aliases extracted from modules themselves.\n")
+        (for-each (match-lambda ((module . aliases)
+                                 (for-each (lambda (alias)
+                                             (format port "alias ~a ~a\n" alias
+                                                     module))
+                                           aliases)))
+                  aliases)))
+    (call-with-output-file (string-append output "/modules.devname")
+      (lambda (port)
+        (format port
+                "# Device nodes to trigger on-demand module loading.\n")
+        (let* ((aliases (append-map (match-lambda
+                                     ((module . aliases) aliases))
+                                    aliases))
+               (devname #f))
+          ;; Note: there's only one devname and then only one (char-major|block-major).
+          (for-each
+           (match-lambda
+            (((? (cut string-prefix? "devname:" <>) alias) . value)
+             (set! devname (string-drop value (string-length "devname:"))))
+            (((? (cut string-prefix? "char-major-" <>) alias) . value)
+             (let ((parts (string-tokenize %not-dash)))
+               (match parts
+                      ((a b major minor)
+                       (format port "~a ~a ~a:~a\n" devname "c" major minor)))))
+            (((? (cut string-prefix? "block-major-" <>) alias) . value)
+             (let ((parts (string-tokenize %not-dash)))
+               (match parts
+                      ((a b major minor)
+                       (format port "~a ~a ~a:~a\n" devname "b" major minor)))))
+            (_ #f))
+           aliases))))))
+
 ;;; linux-modules.scm ends here
D
D
Danny Milosavljevic wrote on 3 Mar 2018 14:55
Download
[PATCH v8 3/7] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180303135533.6112-4-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
(lookup-module): Delete procedure.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 42 +++++++++++++++++++++++++++++++++++-------
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 38 insertions(+), 8 deletions(-)

Toggle diff (75 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..1b16f267a 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -469,9 +469,31 @@ upon error."
              mounts)
         "ext4"))
 
-  (define (lookup-module name)
-    (string-append linux-module-directory "/"
-                   (ensure-dot-ko name)))
+  (define (load-kernel-modules)
+    "Examine /sys/devices to find out which modules to load and load them."
+    (define enter?
+      (const #t))
+    (define (down! directory stat result)
+     ;; Note: modprobe mutates the tree starting with DIRECTORY.
+     (let ((modalias-name (string-append directory "/modalias")))
+       (if (file-exists? modalias-name)
+           (let ((modalias
+                 (string-trim-right (call-with-input-file modalias-name
+                                                          read-string)
+                                    #\newline)))
+             (system* "/sbin/modprobe" "-q" "--" modalias))))
+       #t)
+    (define up
+      (const #t))
+    (define skip
+      (const #t))
+    (define leaf
+      (const #t))
+    (define (error name stat errno result)
+      (format (current-error-port) "warning: ~a: ~a~%"
+              name (strerror errno))
+      result)
+    (file-system-fold enter? leaf down! up skip error #t "/sys/devices"))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
@@ -486,10 +508,16 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (let* ((kernel-release
+               (utsname:release (uname)))
+              (directory
+               (string-append linux-module-directory "/lib/modules/"
+                              kernel-release))
+              (old-umask (umask #o022)))
+         (make-static-device-nodes directory)
+         (umask old-umask))
+
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index e7f97bb88..b50d3ff80 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -208,7 +208,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
D
D
Danny Milosavljevic wrote on 3 Mar 2018 14:55
Download
[PATCH v8 4/7] vm: Allow qemu-image builder to load Linux kernel modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180303135533.6112-5-dannym@scratchpost.org
Download
* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
gnu/system/vm.scm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)

Toggle diff (74 lines)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd..b5a559012 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,20 +286,24 @@ INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
+   (with-imported-modules (source-module-closure '((gnu build activation)
+                                                   (gnu build bootloader)
                                                    (gnu build vm)
                                                    (guix build utils)))
      #~(begin
-         (use-modules (gnu build bootloader)
+         (use-modules (gnu build activation)
+                      (gnu build bootloader)
                       (gnu build vm)
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +317,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +387,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 
 ;;;
D
D
Danny Milosavljevic wrote on 3 Mar 2018 14:55
Download
[PATCH v8 5/7] vm: Make the virtio-blk uniquely identifiable in /sys.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180303135533.6112-6-dannym@scratchpost.org
Download
* gnu/build/vm.scm (load-in-linux-vm): Set virtio-blk pci addr to 0x10.
* gnu/system/vm.scm (common-qemu-options): Set virtio-blk pci addr to 0x10.
---
gnu/build/vm.scm | 2 +-
gnu/system/vm.scm | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)

Toggle diff (27 lines)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..ebf9e9f6e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -154,7 +154,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-device" "virtio-blk,drive=myhd"
+                       `("-device" "virtio-blk-pci,addr=0x10,drive=myhd"
                          "-drive" ,(string-append "if=none,file=" output
                                                   ",format=" disk-image-format
                                                   ",id=myhd"))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index b5a559012..fdff64ed9 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -706,7 +706,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+     "-device" "virtio-blk-pci,addr=0x10,drive=myhd"
+     (format #f "-drive id=myhd,file=~a,if=none,cache=writeback,werror=report,readonly"
              #$image)))
 
 (define* (system-qemu-image/shared-store-script os
D
D
Danny Milosavljevic wrote on 3 Mar 2018 14:55
Download
[PATCH v8 6/7] linux-initrd: Provide modprobe to the initrd.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180303135533.6112-7-dannym@scratchpost.org
Download
* gnu/build/linux-initrd.scm (build-initrd): Provide modprobe and the
linux modules to the initrd.
* gnu/system/linux-initrd.scm (%modprobe): New procedure.
(expression->initrd): Use it. Add linux-module-directory.
(raw-initrd): Pass linux-module-directory.
---
gnu/build/linux-initrd.scm | 13 +++++-
gnu/system/linux-initrd.scm | 99 +++++++++++++++++++++++++++++++++++++++------
2 files changed, 99 insertions(+), 13 deletions(-)

Toggle diff (184 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..d4cb5e2d8 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
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,17 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when modprobe
+      (mkdir-p "sbin")
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index b50d3ff80..8050ac47e 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,11 +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)
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -73,6 +135,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)))
@@ -96,12 +161,17 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        #:modprobe #$modprobe
+                        #:linux-module-directory #$linux-module-directory
+                        ;; 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)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -111,7 +181,7 @@ MODULES and taken from LINUX."
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
                        (srfi srfi-1)
                        (guix build utils)
                        (gnu build linux-modules))
@@ -140,14 +210,18 @@ MODULES and taken from LINUX."
                       (recursive-module-dependencies modules
                                                      #:lookup-module lookup))))
 
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
-
+          (define version
+            (match
+             (filter
+              (lambda (name)
+                (not (string-prefix? "." name)))
+              (scandir module-dir))
+             ((item) item)))
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (install-module-files (delete-duplicates modules) output))
+          #t)))
   (computed-file "linux-modules" build-exp))
 
 (define* (raw-initrd file-systems
@@ -227,6 +301,7 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
D
D
Danny Milosavljevic wrote on 3 Mar 2018 14:55
Download
[PATCH v8 7/7] linux-initrd: Factorize %modprobe and flat-linux-module-directory.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180303135533.6112-8-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (module-aliases->module-file-names): New
procedure.
* gnu/system/linux-initrd.scm (%modprobe): Use
module-aliases->module-file-names.
(flat-linux-module-directory): Use module-aliases->module-file-names.
---
gnu/build/linux-modules.scm | 56 +++++++++++++++++++++-
gnu/system/linux-initrd.scm | 110 ++++++++++++++++++--------------------------
2 files changed, 100 insertions(+), 66 deletions(-)

Toggle diff (249 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index af217c974..44059ad93 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -21,6 +21,7 @@
   #:use-module (guix elf)
   #:use-module (guix glob)
   #:use-module (guix build syscalls)
+  #:use-module (guix build utils) ; find-files
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
@@ -28,9 +29,12 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 ftw)
   #:export (dot-ko
             ensure-dot-ko
             module-aliases
+            module-aliases->module-file-names
             module-dependencies
             recursive-module-dependencies
             modules-loaded
@@ -385,7 +389,7 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
 
 (define (install-module-files module-files output)
   "Install MODULE-FILES to OUTPUT.
-Precondition: OUTPUT is an empty directory."
+Precondition: OUTPUT is an empty directory except for \"modules.builtin\"."
   (let ((aliases
          (map (lambda (module-file-name)
                 (format #t "copying '~a'...~%" module-file-name)
@@ -431,4 +435,54 @@ Precondition: OUTPUT is an empty directory."
             (_ #f))
            aliases))))))
 
+(define (module-aliases->module-file-names linux aliases)
+  "Resolve ALIASES to module file names, including their dependencies (which will appear
+first).  Each alias will map to a list of module file names.
+LINUX is the directory containing \"lib\"."
+  (define (string->regexp str)
+    ;; Return a regexp that matches STR exactly.
+    (string-append "^" (regexp-quote str) "$"))
+
+  (define module-dir
+    (string-append linux "/lib/modules"))
+
+  (define (find-only-entry directory)
+    (match (scandir directory)
+     (("." ".." basename)
+      (string-append directory "/" basename))))
+
+  (define linux-release-module-directory
+    (find-only-entry module-dir))
+
+  (define known-module-aliases*
+    (known-module-aliases
+     (string-append linux-release-module-directory
+                    "/modules.alias")))
+  (define (resolve-alias alias)
+    "If possible, resolve ALIAS to a list of module names.
+Otherwise return just ALIAS as possible module names."
+    (match (delete-duplicates (matching-modules alias
+                                                known-module-aliases*))
+           (()
+            (list alias))
+           (items
+            items)))
+
+  (define (lookup module)
+    (let ((name (ensure-dot-ko module)))
+      (match (find-files module-dir (string->regexp name))
+             ((file)
+              file)
+             (()
+              (error "module not found" name module-dir))
+             ((_ ...)
+              (error "several modules by that name"
+                     name module-dir)))))
+  (append-map (lambda (alias)
+                (let ((modules (map lookup (resolve-alias alias))))
+                  (append (recursive-module-dependencies modules
+                                                         #:lookup-module
+                                                         lookup) modules)))
+              aliases))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 8050ac47e..dc826c63e 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -58,35 +58,14 @@
 
 (define* (%modprobe linux-module-directory #:key
                     (guile %guile-static-stripped))
+  "Minimal implementation of modprobe for our initrd.
+LINUX-MODULE-DIRECTORY is the directory that contains \"lib\"."
   (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))))
+                       (ice-9 match) (srfi srfi-1))
           (define option-spec
            '((quiet    (single-char #\q) (value #f))))
           (define options
@@ -98,22 +77,31 @@
             (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)))
+                        ((() aliases ...)
+                         (catch #t
+                           (lambda ()
+                             (let ((module-file-names
+                                    (module-aliases->module-file-names
+                                     #$linux-module-directory aliases)))
+                               (for-each (lambda (name)
+                                           (catch 'system-error
+                                             (lambda ()
+                                               (when (not (load-linux-module* name
+                                                                              #:recursive?
+                                                                              #f))
+                                                 (set! exit-status 1)))
+                                             (lambda (key . args)
+                                               (when (not (= EEXIST
+                                                             (system-error-errno
+                                                              (cons key args))))
+                                                 (print-exception (current-error-port)
+                                                                  #f key args)
+                                                 (set! exit-status 1)))))
+                                         module-file-names)))
+                           (lambda (key . args)
+                             (print-exception (current-error-port)
+                                              #f key args)
+                             (set! exit-status 1)))))
                       options)
             (exit exit-status))))
   #:guile guile))
@@ -173,17 +161,17 @@ the derivations referenced by EXP are automatically copied to the initrd."
                     #:references-graphs `(("init-closure" ,init)
                                           ("modprobe-closure" ,modprobe))))
 
-(define (flat-linux-module-directory linux modules)
-  "Return a flat directory containing the Linux kernel modules listed in
-MODULES and taken from LINUX."
+(define (flat-linux-module-directory linux aliases)
+  "Return a flat directory containing the Linux kernel modules resolved by
+ALIASES and taken from LINUX."
   (define build-exp
     (with-imported-modules (source-module-closure
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
+          (use-modules (ice-9 match) (ice-9 ftw)
                        (srfi srfi-1)
-                       (guix build utils)
+                       (guix build utils) ; TODO: Remove
                        (gnu build linux-modules))
 
           (define (string->regexp str)
@@ -193,33 +181,25 @@ MODULES and taken from LINUX."
           (define module-dir
             (string-append #$linux "/lib/modules"))
 
-          (define (lookup module)
-            (let ((name (ensure-dot-ko module)))
-              (match (find-files module-dir (string->regexp name))
-                ((file)
-                 file)
-                (()
-                 (error "module not found" name module-dir))
-                ((_ ...)
-                 (error "several modules by that name"
-                        name module-dir)))))
+          (define (find-only-entry directory)
+            (match (scandir directory)
+             (("." ".." basename)
+              (string-append directory "/" basename))))
+
+          (define linux-release-module-directory
+            (find-only-entry module-dir))
 
           (define modules
-            (let ((modules (map lookup '#$modules)))
-              (append modules
-                      (recursive-module-dependencies modules
-                                                     #:lookup-module lookup))))
+            (module-aliases->module-file-names #$linux '#$aliases))
 
           (define version
-            (match
-             (filter
-              (lambda (name)
-                (not (string-prefix? "." name)))
-              (scandir module-dir))
-             ((item) item)))
+            (basename linux-release-module-directory))
 
           (let ((output (string-append #$output "/lib/modules/" version)))
             (mkdir-p output)
+            (install-file
+             (string-append linux-release-module-directory "/modules.builtin")
+             output)
             (install-module-files (delete-duplicates modules) output))
           #t)))
   (computed-file "linux-modules" build-exp))
D
D
Danny Milosavljevic wrote on 3 Mar 2018 16:32
Download
Re: [PATCH v8 2/7] linux-modules: Add install-modules.
(address . 30604@debbugs.gnu.org)
20180303163212.40f17905@scratchpost.org
Download
Toggle quote (18 lines)
> + ;; Note: there's only one devname and then only one (char-major|block-major).
> + (for-each
> + (match-lambda
> + (((? (cut string-prefix? "devname:" <>) alias) . value)
> + (set! devname (string-drop value (string-length "devname:"))))
> + (((? (cut string-prefix? "char-major-" <>) alias) . value)
> + (let ((parts (string-tokenize %not-dash)))
> + (match parts
> + ((a b major minor)
> + (format port "~a ~a ~a:~a\n" devname "c" major minor)))))
> + (((? (cut string-prefix? "block-major-" <>) alias) . value)
> + (let ((parts (string-tokenize %not-dash)))
> + (match parts
> + ((a b major minor)
> + (format port "~a ~a ~a:~a\n" devname "b" major minor)))))
> + (_ #f))
> + aliases))))))

Probably better to be more careful that devname is set early enough.
Download
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAlqav/wACgkQ5xo1VCww
uqV50wf/VBhDH1xsp4i365g/suHyV27f38/lFep7ohe11uMGlKxolmCCaGoo8/bC
lhVuRnGme8dWV3DaKW8Ih+DE82FkZr+EulBxK9MmPxuw3FRCZDqw058PPkjM+pAM
a09O8uj3qHTsWhNZzKA+Mf0o442+Pz4MwQE2JnX1eEuFltTzBrVAKjIsgbHgmRfh
OAfPnmmBK3lNRTDB/qLvc6U1iuZOP+JduRr05kr7cjOFDZ2Rr0Q1dgB034GXwlj0
3dCw2izbdKc6xhGP5wjDt6Hradg+ReglrDgLzh0mXY0hq9aUIvXxj9ngA3Q05gu1
5n9B45TPg7OOKL7hsHumczfWFXLBLA==
=EtMr
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 3 Mar 2018 19:01
Download
Re: [PATCH v8 7/7] linux-initrd: Factorize %modprobe and flat-linux-module-directory.
(address . 30604@debbugs.gnu.org)
20180303190131.5a400f7d@scratchpost.org
Download
Toggle quote (2 lines)
> + (guix build utils) ; TODO: Remove

Required for mkdir-p
Download
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAlqa4vsACgkQ5xo1VCww
uqXOsgf/YAhsza+9v+prxTjzBWMjmdnk4mmMOMjJMoKQvMJlUDKzpVGXRBmmiAXc
gkDel+oaMwi59dhe9jCmMb6cxDETIrFWk7HTHnjpAW5TwS6giIDu4ka83Qk65hI0
cQYgntsHOLfoOrONKnZ9Aw6TnG19lZAsyga1efmFllvyuU+tXuKAde2YZhrbx9ri
vvKJTIVmeAd5tXRxhw44yniPigWS2MRJkEasgYOJPNbaBtoZ4JkfIaWkBIGxsDtF
uVw+JxlMqp/SlbnPPEdYasDWSijIv9ypqAFjNoU/oZd9NqjO8ORSdctRutKy///R
ANg1nn1m7F3x48yAenSc78etjezWfA==
=ILLM
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 3 Mar 2018 22:58
Download
Re: [bug#30604] [PATCH v8 1/7] linux-modules: Add module-aliases.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)(address . 30604@debbugs.gnu.org)
87371g6ctv.fsf@gnu.org
Download
Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (2 lines)
> * gnu/build/linux-modules.scm (module-aliases): New variable.

LGTM!

Toggle quote (8 lines)
> +(define (module-aliases file)
> + "Return the list of aliases of module FILE."
> + (let ((info (modinfo-section-contents file)))
> + (filter-map (match-lambda
> + (('alias . value)
> + value)
> + (_ #f)) (modinfo-section-contents file))))

Nitpick: align like this:

(filter-map first
second)

when the first arg spans several lines.
L
L
Ludovic Courtès wrote on 3 Mar 2018 23:07
Download
Re: [bug#30604] [PATCH v8 2/7] linux-modules: Add install-modules.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)(address . 30604@debbugs.gnu.org)
87y3j84xtu.fsf@gnu.org
Download
Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (3 lines)
> * gnu/build/linux-modules.scm (install-modules): New procedure.
> (%not-dash): New variable.

We could reuse modules.alias and modules.devname from the ‘linux-libre’
package (right?), but I guess it doesn’t hurt to generate custom ones.

Toggle quote (48 lines)
> +(define (install-module-files module-files output)
> + "Install MODULE-FILES to OUTPUT.
> +Precondition: OUTPUT is an empty directory."
> + (let ((aliases
> + (map (lambda (module-file-name)
> + (format #t "copying '~a'...~%" module-file-name)
> + (copy-file module-file-name
> + (string-append output "/"
> + (basename module-file-name)))
> + `(,(file-name->module-name module-file-name) .
> + ,(module-aliases module-file-name)))
> + (sort module-files string<))))
> + (call-with-output-file (string-append output "/modules.alias")
> + (lambda (port)
> + (format port
> + "# Aliases extracted from modules themselves.\n")
> + (for-each (match-lambda ((module . aliases)
> + (for-each (lambda (alias)
> + (format port "alias ~a ~a\n" alias
> + module))
> + aliases)))
> + aliases)))
> + (call-with-output-file (string-append output "/modules.devname")
> + (lambda (port)
> + (format port
> + "# Device nodes to trigger on-demand module loading.\n")
> + (let* ((aliases (append-map (match-lambda
> + ((module . aliases) aliases))
> + aliases))
> + (devname #f))
> + ;; Note: there's only one devname and then only one (char-major|block-major).
> + (for-each
> + (match-lambda
> + (((? (cut string-prefix? "devname:" <>) alias) . value)
> + (set! devname (string-drop value (string-length "devname:"))))
> + (((? (cut string-prefix? "char-major-" <>) alias) . value)
> + (let ((parts (string-tokenize %not-dash)))
> + (match parts
> + ((a b major minor)
> + (format port "~a ~a ~a:~a\n" devname "c" major minor)))))
> + (((? (cut string-prefix? "block-major-" <>) alias) . value)
> + (let ((parts (string-tokenize %not-dash)))
> + (match parts
> + ((a b major minor)
> + (format port "~a ~a ~a:~a\n" devname "b" major minor)))))
> + (_ #f))
> + aliases))))))

I think we need different procedures here:

(write-module-alias-database modules port) ;for “modules.alias”
(write-module-device-database modules port) ;for “modules.devname”

with docstrings.

I’m not sure we need ‘install-module-files’ itself. Perhaps we can
inline it at the call site?

For the devname code, please avoid ‘set!’. Instead you can thread the
current devname as the state of a loop:

(let loop ((devname #f)
(aliases aliases))
(match aliases
(() …)
(((? devname-alias? devname) . rest)
(loop devname rest))
…))
The indentation of ‘match’ forms is wrong. Would it be OK for you to
pass it through ./etc/indent-code.el? (It’s non interactive, you don’t
need to actually use Emacs.)

Thanks,
Ludo’.
L
L
Ludovic Courtès wrote on 3 Mar 2018 23:48
Download
Re: [bug#30604] [PATCH v8 3/7] linux-boot: Load kernel modules only when the hardware is present.
(name . Danny Milosavljevic)(address . dannym@scratchpost.org)(address . 30604@debbugs.gnu.org)
87sh9g4vy1.fsf@gnu.org
Download
Danny Milosavljevic <dannym@scratchpost.org> skribis:

Toggle quote (5 lines)
> * gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
> the hardware is present.
> (lookup-module): Delete procedure.
> * gnu/system/linux-initrd.scm (raw-initrd): Add imports.

[...]

Toggle quote (14 lines)
> + (define (load-kernel-modules)
> + "Examine /sys/devices to find out which modules to load and load them."
> + (define enter?
> + (const #t))
> + (define (down! directory stat result)
> + ;; Note: modprobe mutates the tree starting with DIRECTORY.
> + (let ((modalias-name (string-append directory "/modalias")))
> + (if (file-exists? modalias-name)
> + (let ((modalias
> + (string-trim-right (call-with-input-file modalias-name
> + read-string)
> + #\newline)))
> + (system* "/sbin/modprobe" "-q" "--" modalias))))

If we change ‘flat-linux-module-directory’ to produce a ‘modules.alias’
file, here we could read ‘modules.aliases’ directly and load the right
thing.

With the patch below, we get ‘needed-modules’, and we could simply do:

(for-each (catch-ENOENT load-linux-module*)
(needed-modules
(known-module-aliases (string-append linux-module-directory
"/modules.alias"))))

and we can do away with kmod’s modprobe.

Thoughts?

Ludo’.
Download
Toggle diff (48 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 4a6d4ff08..251095072 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -20,6 +20,7 @@
 (define-module (gnu build linux-modules)
   #:use-module (guix elf)
   #:use-module (guix glob)
+  #:use-module (guix build utils)
   #:use-module (guix build syscalls)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
@@ -40,7 +41,8 @@
 
             device-module-aliases
             known-module-aliases
-            matching-modules))
+            matching-modules
+            needed-modules))
 
 ;;; Commentary:
 ;;;
@@ -370,4 +372,25 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                       module)))
               known-aliases))
 
+(define (system-device-aliases)
+  "Browse /sys/devices in search of \"modalias\" files and return the list of
+device aliases for the current system."
+  (let ((files (find-files "/sys/devices"
+                           (lambda (file stat)
+                             (and (eq? 'regular (stat:type stat))
+                                  (string=? "modalias" (basename file)))))))
+    (filter-map (lambda (file)
+                  (match (string-trim-right
+                          (call-with-input-file file get-string-all))
+                    ("" #f)
+                    (alias alias)))
+                files)))
+
+(define* (needed-modules #:optional (known-aliases (known-module-aliases)))
+  "Return the list of modules needed by devices on the current system.  This
+is achieved by browsing /sys/devices and returning the maching modules from
+KNOWN-ALIASES."
+  (append-map (cut matching-modules <> known-aliases)
+              (system-device-aliases)))
+
 ;;; linux-modules.scm ends here
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:06
Download
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 30604@debbugs.gnu.org)
20180304020643.6773e016@scratchpost.org
Download
Hi Ludo,

On Sat, 03 Mar 2018 23:48:38 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

Toggle quote (15 lines)
> > + (system* "/sbin/modprobe" "-q" "--" modalias))))
>
> If we change ‘flat-linux-module-directory’ to produce a ‘modules.alias’
> file, here we could read ‘modules.aliases’ directly and load the right
> thing.
>
> With the patch below, we get ‘needed-modules’, and we could simply do:
>
> (for-each (catch-ENOENT load-linux-module*)
> (needed-modules
> (known-module-aliases (string-append linux-module-directory
> "/modules.alias"))))
>
> and we can do away with kmod’s modprobe.

It's not kmod's modprobe anymore. It's our pure-Guile implementation.

Linux lazy-invokes modprobe (for example when mounting stuff), so
/sbin/modprobe is never going away - but it can be our implementation.

I doubt it will take the modules from the correct directory with your patch.
(Of course otherwise it looks much nicer - but I think it won't pass the tests)

My newest version (v9) will use the same procedure for both computing the list
of modules for flat-linux-module-directory and the list of modules that are to
be modprobed - I think it's nice to be able to keep those in sync so we don't
get nasty surprises. Let's see how that goes...
Download
-----BEGIN PGP SIGNATURE-----

iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAlqbRqMACgkQ5xo1VCww
uqXDwQgAowI5zaIU+SBYbyZPcBgJoXZC0c5raPEdUouIjGTcIY3A0uIY9hLfuMDX
kX+Sg60ZEvxBtoJmsy9eMNKlvuzVduB8jNEouH1MQcUBLu6wSLvHhkQRHjamAHkN
oRKpLTj429itvdQ0jNewulqshW3xeeneepYDITKFD/sOAHt/ek0DFthYYxIJUEXY
PXLkJ+O2mCyspt4uoc+8L+4dtEO9gv3asmu4mhk8D5+bXZ0DgBVsNqmQrOe3XSkc
S0no3CafpSInmq+HuGAbFwnJcQbp1ISd3AoSMXEBAfaSVoaE/ZzKFKLgavNuvbpD
SQdW8dstK+ZyUiOP6KiaG3g5tn2AHg==
=Qtnk
-----END PGP SIGNATURE-----


D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:09
Download
[PATCH v9 0/7] Load Linux module only when supported hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180304010914.1322-1-dannym@scratchpost.org
Download
Danny Milosavljevic (7):
linux-modules: Add "modules.devname" and "modules.alias" writer.
linux-modules: Add module-aliases->module-file-names.
linux-initrd: Provide pure-Guile modprobe.
linux-boot: Load kernel modules only when the hardware is present.
vm: Allow qemu-image builder to load Linux kernel modules.
vm: Make the virtio-blk uniquely identifiable in /sys.
linux-initrd: Use module-aliases->module-file-names, too.

gnu/build/linux-boot.scm | 42 +++++++++++---
gnu/build/linux-initrd.scm | 13 ++++-
gnu/build/linux-modules.scm | 114 +++++++++++++++++++++++++++++++++++++
gnu/build/vm.scm | 2 +-
gnu/system/linux-initrd.scm | 136 +++++++++++++++++++++++++++++++++-----------
gnu/system/vm.scm | 34 +++++++++--
6 files changed, 295 insertions(+), 46 deletions(-)
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:09
Download
[PATCH v9 1/7] linux-modules: Add "modules.devname" and "modules.alias" writer.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180304010914.1322-2-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (write-module-alias-database): New procedure.
(write-module-device-database): New procedure.
(%not-dash): New variable.
---
gnu/build/linux-modules.scm | 58 +++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 58 insertions(+)

Toggle diff (74 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 4fe673cca..0aaf2ff6f 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -36,6 +36,8 @@
             modules-loaded
             module-loaded?
             load-linux-module*
+            write-module-alias-database
+            write-module-device-database
 
             current-module-debugging-port
 
@@ -380,4 +382,60 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                       module)))
               known-aliases))
 
+(define %not-dash
+  (char-set-complement (char-set #\-)))
+
+(define (write-module-alias-database aliases output)
+  "Install \"modules.alias\" for ALIASES to directory OUTPUT."
+  (call-with-output-file (string-append output "/modules.alias")
+    (lambda (port)
+      (format port
+              "# Aliases extracted from modules themselves.\n")
+      (for-each (match-lambda ((module . aliases)
+                               (for-each (lambda (alias)
+                                           (format port "alias ~a ~a\n" alias
+                                                   module))
+                                         aliases)))
+                aliases))))
+
+(define (write-module-device-database aliases output)
+  "Install \"modules.devname\" for ALIASES to directory OUTPUT."
+  (call-with-output-file (string-append output "/modules.devname")
+    (lambda (port)
+      (format port
+              "# Device nodes to trigger on-demand module loading.\n")
+      (for-each (match-lambda
+                 ((module . aliases)
+                  (let* ((interesting-aliases
+                          ;; Note: there's only one devname and then only one
+                          ;; (char-major|block-major).
+                          (filter-map
+                           (match-lambda
+                            ((? (cut string-prefix? "devname:" <>) alias)
+                             `(devname . ,(string-drop alias (string-length "devname:"))))
+                            ((? (cut string-prefix? "char-major-" <>) alias)
+                             `(char-major . ,(string-drop alias (string-length "char-major-"))))
+                            ((? (cut string-prefix? "block-major-" <>) alias)
+                             `(block-major . ,(string-drop alias (string-length "block-major-"))))
+                            (_ #f))
+                           aliases))
+                         (devname (assq-ref interesting-aliases
+                                            'devname))
+                         (char-major (assq-ref interesting-aliases
+                                               'char-major))
+                         (block-major (assq-ref interesting-aliases
+                                               'block-major)))
+                    (when (and devname char-major)
+                      (let ((parts (string-tokenize char-major %not-dash)))
+                        (match parts
+                         ((major minor)
+                          (format port "~a ~a ~a~a:~a\n" module devname
+                                       "c" major minor)))))
+                    (when (and devname block-major)
+                      (let ((parts (string-tokenize block-major %not-dash)))
+                        (match parts
+                         ((major minor)
+                          (format port "~a ~a ~a~a:~a\n" module devname
+                                       "b" major minor)))))))) aliases))))
+
 ;;; linux-modules.scm ends here
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:09
Download
[PATCH v9 2/7] linux-modules: Add module-aliases->module-file-names.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180304010914.1322-3-dannym@scratchpost.org
Download
* gnu/build/linux-modules.scm (module-aliases->module-file-names): New
procedure.
---
gnu/build/linux-modules.scm | 55 +++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 55 insertions(+)

Toggle diff (81 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 0aaf2ff6f..f6bb0512b 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -21,6 +21,7 @@
   #:use-module (guix elf)
   #:use-module (guix glob)
   #:use-module (guix build syscalls)
+  #:use-module (guix build utils) ; find-files
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
@@ -28,9 +29,12 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 ftw)
   #:export (dot-ko
             ensure-dot-ko
             module-aliases
+            module-aliases->module-file-names
             module-dependencies
             recursive-module-dependencies
             modules-loaded
@@ -438,4 +442,55 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                           (format port "~a ~a ~a~a:~a\n" module devname
                                        "b" major minor)))))))) aliases))))
 
+(define (module-aliases->module-file-names linux aliases)
+  "Resolve ALIASES to module file names, including their dependencies (which will appear
+first).  Each alias will map to a list of module file names.
+LINUX is the directory containing \"lib\"."
+  (define (string->regexp str)
+    ;; Return a regexp that matches STR exactly.
+    (string-append "^" (regexp-quote str) "$"))
+
+  (define module-dir
+    (string-append linux "/lib/modules"))
+
+  (define (find-only-entry directory)
+    (match (scandir directory)
+     (("." ".." basename)
+      (string-append directory "/" basename))))
+
+  (define linux-release-module-directory
+    (find-only-entry module-dir))
+
+  (define known-module-aliases*
+    (known-module-aliases
+     (string-append linux-release-module-directory
+                    "/modules.alias")))
+  (define (resolve-alias alias)
+    "If possible, resolve ALIAS to a list of module names.
+Otherwise return just ALIAS as possible module names."
+    (match (delete-duplicates (matching-modules alias
+                                                known-module-aliases*))
+           (()
+            (list alias))
+           (items
+            items)))
+
+  (define (lookup module)
+    (let ((name (ensure-dot-ko module)))
+      (match (find-files module-dir (string->regexp name))
+             ((file)
+              file)
+             (()
+              (error "module not found" name module-dir))
+             ((_ ...)
+              (error "several modules by that name"
+                     name module-dir)))))
+  (append-map (lambda (alias)
+                (let ((modules (map lookup (resolve-alias alias))))
+                  (append (recursive-module-dependencies modules
+                                                         #:lookup-module
+                                                         lookup)
+                          modules)))
+              aliases))
+
 ;;; linux-modules.scm ends here
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:09
Download
[PATCH v9 3/7] linux-initrd: Provide pure-Guile modprobe.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180304010914.1322-4-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (%modprobe): New variable.
(expression->initrd): Add modprobe, LINUX-MODULE-DIRECTORY.
(raw-initrd): Pass KODIR as LINUX-MODULE-DIRECTORY.
* gnu/build/linux-initrd.scm (build-initrd): Add modprobe.
---
gnu/build/linux-initrd.scm | 13 ++++++++-
gnu/system/linux-initrd.scm | 65 ++++++++++++++++++++++++++++++++++++++++++---
2 files changed, 74 insertions(+), 4 deletions(-)

Toggle diff (144 lines)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..d4cb5e2d8 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
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,17 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when modprobe
+      (mkdir-p "sbin")
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index e0cb59c00..6ad6d75f7 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -46,7 +46,8 @@
             %base-initrd-modules
             raw-initrd
             file-system-packages
-            base-initrd))
+            base-initrd
+            %modprobe))
 
 
 ;;; Commentary:
@@ -56,11 +57,61 @@
 ;;;
 ;;; Code:
 
+(define* (%modprobe linux-module-directory #:key
+                    (guile %guile-static-stripped))
+  "Minimal implementation of modprobe for our initrd.
+LINUX-MODULE-DIRECTORY is the directory that contains \"lib\"."
+  (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))
+          (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)
+                        ((() aliases ...)
+                         (catch #t
+                           (lambda ()
+                             (let ((module-file-names
+                                    (module-aliases->module-file-names
+                                     #$linux-module-directory aliases)))
+                               (for-each (lambda (name)
+                                           (catch 'system-error
+                                             (lambda ()
+                                               (when (not (load-linux-module* name
+                                                                              #:recursive?
+                                                                              #f))
+                                                 (set! exit-status 1)))
+                                             (lambda (key . args)
+                                               (when (not (= EEXIST
+                                                             (system-error-errno
+                                                              (cons key args))))
+                                                 (print-exception (current-error-port)
+                                                                  #f key args)
+                                                 (set! exit-status 1)))))
+                                         module-file-names)))
+                           (lambda (key . args)
+                             (print-exception (current-error-port)
+                                              #f key args)
+                             (set! exit-status 1)))))
+                      options)
+            (exit exit-status))))
+  #:guile guile))
 
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -73,6 +124,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)))
@@ -96,12 +150,16 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
+                        #:modprobe #$modprobe
+                        #:linux-module-directory #$linux-module-directory
                         ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        #: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)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -225,6 +283,7 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:09
Download
[PATCH v9 4/7] linux-boot: Load kernel modules only when the hardware is present.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180304010914.1322-5-dannym@scratchpost.org
Download
* gnu/build/linux-boot.scm (boot-system): Load kernel modules only when
the hardware is present.
* gnu/system/linux-initrd.scm (raw-initrd): Add imports.
---
gnu/build/linux-boot.scm | 42 +++++++++++++++++++++++++++++++++++-------
gnu/system/linux-initrd.scm | 4 +++-
2 files changed, 38 insertions(+), 8 deletions(-)

Toggle diff (75 lines)
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..2236d8971 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -469,9 +469,31 @@ upon error."
              mounts)
         "ext4"))
 
-  (define (lookup-module name)
-    (string-append linux-module-directory "/"
-                   (ensure-dot-ko name)))
+  (define (load-kernel-modules)
+    "Examine /sys/devices to find out which modules to load and load them."
+    (define enter?
+      (const #t))
+    (define (down! directory stat result)
+     ;; Note: modprobe mutates the tree starting with DIRECTORY.
+     (let ((modalias-name (string-append directory "/modalias")))
+       (if (file-exists? modalias-name)
+           (let ((modalias
+                 (string-trim-right (call-with-input-file modalias-name
+                                                          read-string)
+                                    #\newline)))
+             (system* "/sbin/modprobe" "-q" "--" modalias))))
+       #t)
+    (define up
+      (const #t))
+    (define skip
+      (const #t))
+    (define leaf
+      (const #t))
+    (define (error name stat errno result)
+      (format (current-error-port) "warning: ~a: ~a~%"
+              name (strerror errno))
+      result)
+    (file-system-fold enter? leaf down! up skip error #t "/sys/devices"))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
@@ -486,10 +508,16 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
-       (display "loading kernel modules...\n")
-       (for-each (cut load-linux-module* <>
-                      #:lookup-module lookup-module)
-                 (map lookup-module linux-modules))
+       (let* ((kernel-release
+               (utsname:release (uname)))
+              (directory
+               (string-append linux-module-directory "/lib/modules/"
+                              kernel-release))
+              (old-umask (umask #o022)))
+         (make-static-device-nodes directory)
+         (umask old-umask))
+
+       (load-kernel-modules)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 6ad6d75f7..339ecf754 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -266,7 +266,9 @@ upon error."
                       ;; this info via gexps.
                       ((gnu build file-systems)
                        #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                      (rnrs bytevectors)
+                      (ice-9 ftw)
+                      (ice-9 rdelim))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:09
Download
[PATCH v9 5/7] vm: Allow qemu-image builder to load Linux kernel modules.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180304010914.1322-6-dannym@scratchpost.org
Download
* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
gnu/system/vm.scm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)

Toggle diff (74 lines)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 91ff32ce9..cf1ec651a 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,20 +286,24 @@ INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
+   (with-imported-modules (source-module-closure '((gnu build activation)
+                                                   (gnu build bootloader)
                                                    (gnu build vm)
                                                    (guix build utils)))
      #~(begin
-         (use-modules (gnu build bootloader)
+         (use-modules (gnu build activation)
+                      (gnu build bootloader)
                       (gnu build vm)
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +317,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +387,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 
 ;;;
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:09
Download
[PATCH v9 6/7] vm: Make the virtio-blk uniquely identifiable in /sys.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180304010914.1322-7-dannym@scratchpost.org
Download
* gnu/build/vm.scm (load-in-linux-vm): Set virtio-blk pci addr to 0x10.
* gnu/system/vm.scm (common-qemu-options): Set virtio-blk pci addr to 0x10.
---
gnu/build/vm.scm | 2 +-
gnu/system/vm.scm | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)

Toggle diff (27 lines)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index fe003ea45..ebf9e9f6e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -154,7 +154,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-device" "virtio-blk,drive=myhd"
+                       `("-device" "virtio-blk-pci,addr=0x10,drive=myhd"
                          "-drive" ,(string-append "if=none,file=" output
                                                   ",format=" disk-image-format
                                                   ",id=myhd"))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index cf1ec651a..78cc8cad1 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -700,7 +700,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+     "-device" "virtio-blk-pci,addr=0x10,drive=myhd"
+     (format #f "-drive id=myhd,file=~a,if=none,cache=writeback,werror=report,readonly"
              #$image)))
 
 (define* (system-qemu-image/shared-store-script os
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:09
Download
[PATCH v9 7/7] linux-initrd: Use module-aliases->module-file-names, too.
(address . 30604@debbugs.gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20180304010914.1322-8-dannym@scratchpost.org
Download
* gnu/system/linux-initrd.scm (flat-linux-module-directory): Use
module-aliases->module-file-names.
* gnu/build/linux-modules.scm (file-name->module-name): Export.
---
gnu/build/linux-modules.scm | 1 +
gnu/system/linux-initrd.scm | 67 ++++++++++++++++++++++++++-------------------
2 files changed, 40 insertions(+), 28 deletions(-)

Toggle diff (105 lines)
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index f6bb0512b..81a4b15b1 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -35,6 +35,7 @@
             ensure-dot-ko
             module-aliases
             module-aliases->module-file-names
+            file-name->module-name
             module-dependencies
             recursive-module-dependencies
             modules-loaded
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 339ecf754..0b976afad 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -161,17 +161,17 @@ the derivations referenced by EXP are automatically copied to the initrd."
                     #:references-graphs `(("init-closure" ,init)
                                           ("modprobe-closure" ,modprobe))))
 
-(define (flat-linux-module-directory linux modules)
-  "Return a flat directory containing the Linux kernel modules listed in
-MODULES and taken from LINUX."
+(define (flat-linux-module-directory linux aliases)
+  "Return a flat directory containing the Linux kernel modules resolved by
+ALIASES and taken from LINUX."
   (define build-exp
     (with-imported-modules (source-module-closure
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 ftw)
                        (srfi srfi-1)
-                       (guix build utils)
+                       (guix build utils) ; mkdir-p
                        (gnu build linux-modules))
 
           (define (string->regexp str)
@@ -181,31 +181,42 @@ MODULES and taken from LINUX."
           (define module-dir
             (string-append #$linux "/lib/modules"))
 
-          (define (lookup module)
-            (let ((name (ensure-dot-ko module)))
-              (match (find-files module-dir (string->regexp name))
-                ((file)
-                 file)
-                (()
-                 (error "module not found" name module-dir))
-                ((_ ...)
-                 (error "several modules by that name"
-                        name module-dir)))))
+          (define (find-only-entry directory)
+            (match (scandir directory)
+             (("." ".." basename)
+              (string-append directory "/" basename))))
 
-          (define modules
-            (let ((modules (map lookup '#$modules)))
-              (append modules
-                      (recursive-module-dependencies modules
-                                                     #:lookup-module lookup))))
-
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
+          (define linux-release-module-directory
+            (find-only-entry module-dir))
 
+          (define modules
+            (module-aliases->module-file-names #$linux '#$aliases))
+
+          (define version
+            (basename linux-release-module-directory))
+
+          (define (install-module-files module-files output)
+            "Install MODULE-FILES to OUTPUT.
+Precondition: OUTPUT is an empty directory except for \"modules.builtin\"."
+            (let ((aliases
+                   (map (lambda (module-file-name)
+                          (format #t "copying '~a'...~%" module-file-name)
+                          (copy-file module-file-name
+                           (string-append output "/"
+                                          (basename module-file-name)))
+                         `(,(file-name->module-name module-file-name) .
+                            ,(module-aliases module-file-name)))
+                     (sort module-files string<))))
+              (install-file (string-append linux-release-module-directory
+                                           "/modules.builtin")
+                            output)
+              (write-module-alias-database aliases output)
+              (write-module-device-database aliases output)))
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (install-module-files (delete-duplicates modules) output)
+            #t))))
   (computed-file "linux-modules" build-exp))
 
 (define* (raw-initrd file-systems
D
D
Danny Milosavljevic wrote on 4 Mar 2018 02:54
Download
Re: [bug#30604] [PATCH v8 3/7] linux-boot: Load kernel modules only when the hardware is present.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 30604@debbugs.gnu.org)