[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Ludovic Courtès]

Hello Guix!

This patch series aims to allow ‘guix system init’ & co. to detect
kernel modules that are missing from the initrd, which would typically
render the system unbootable.

To do that it adds code in (gnu build linux-modules) to determine the
modules needed for a particular device:

--8<---------------cut here---------------start------------->8---
$ sudo ./pre-inst-env guile
GNU Guile 2.2.3
Copyright (C) 1995-2017 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> ,use (gnu build linux-modules)
scheme@(guile-user)> ,use (srfi srfi-1)
scheme@(guile-user)> (append-map matching-modules (device-module-aliases "/dev/sda2"))
$1 = ("ahci" "ahci")
--8<---------------cut here---------------end--------------->8---

It then adds an ‘initrd-modules’ field to ‘operating-system’ as a way to
expose the list of modules requested for the initrd.

Finally, it augments ‘guix system’ to perform the necessary checks.

It works, but with a few caveats:

  1. ‘device-module-aliases’ returns the empty list for /dev/dm-0, which
     is a LUKS device on my laptop.  I’m not sure what it would take to
     have it return “dm-crypt”, etc.  Same for RAID devices.

  2. Let’s assume you have: (initrd-modules '("a")).  ‘guix system’
     could report that module “b” is missing, even if “b” is actually a
     dependency of “a” and will therefore be automatically included in
     the initrd.  I think that’s an acceptable limitation (fixing it is
     non-trivial since we’d ideally need to build the target kernel so
     we can inspect its modules and determine their closure.)

You’re welcome to give it a try.  In particular it’d be great if you
could check that ‘device-module-aliases’ returns the right thing on your
machine, as I shown in the example above.

Note that, in addition to that, we could also have a tool to generate a
template ‘operating-system’ declaration.  Let’s say:

  guix system template desktop encrypted-root

would generate a config based on the desktop config but with the right
‘initrd-modules’.

Feedback & suggestions welcome!

Ludo’.

Ludovic Courtès (5):
  Add (guix glob).
  linux-modules: Add 'device-module-aliases' and related procedures.
  linux-initrd: Separate file system module logic.
  system: Add 'initrd-modules' field.
  guix system: Check for the lack of modules in the initrd.

 Makefile.am                   |   4 +-
 doc/guix.texi                 |  42 ++++++++---
 gnu/build/linux-modules.scm   | 161 +++++++++++++++++++++++++++++++++++++++++-
 gnu/system.scm                |   8 +++
 gnu/system/install.scm        |   7 +-
 gnu/system/linux-initrd.scm   |  94 ++++++++++++++----------
 gnu/system/mapped-devices.scm |  53 ++++++++++----
 gnu/tests/install.scm         |  11 ++-
 guix/glob.scm                 |  97 +++++++++++++++++++++++++
 guix/scripts/system.scm       |  67 +++++++++++++++---
 tests/glob.scm                |  58 +++++++++++++++
 11 files changed, 519 insertions(+), 83 deletions(-)
 create mode 100644 guix/glob.scm
 create mode 100644 tests/glob.scm

-- 
2.16.2

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Ludovic Courtès]

Hello Guix!

This patch series aims to allow ‘guix system init’ & co. to detect
kernel modules that are missing from the initrd, which would typically
render the system unbootable.

To do that it adds code in (gnu build linux-modules) to determine the
modules needed for a particular device:

--8<---------------cut here---------------start------------->8---
$ sudo ./pre-inst-env guile
GNU Guile 2.2.3
Copyright (C) 1995-2017 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> ,use (gnu build linux-modules)
scheme@(guile-user)> ,use (srfi srfi-1)
scheme@(guile-user)> (append-map matching-modules (device-module-aliases "/dev/sda2"))
$1 = ("ahci" "ahci")
--8<---------------cut here---------------end--------------->8---

It then adds an ‘initrd-modules’ field to ‘operating-system’ as a way to
expose the list of modules requested for the initrd.

Finally, it augments ‘guix system’ to perform the necessary checks.

It works, but with a few caveats:

  1. ‘device-module-aliases’ returns the empty list for /dev/dm-0, which
     is a LUKS device on my laptop.  I’m not sure what it would take to
     have it return “dm-crypt”, etc.  Same for RAID devices.

  2. Let’s assume you have: (initrd-modules '("a")).  ‘guix system’
     could report that module “b” is missing, even if “b” is actually a
     dependency of “a” and will therefore be automatically included in
     the initrd.  I think that’s an acceptable limitation (fixing it is
     non-trivial since we’d ideally need to build the target kernel so
     we can inspect its modules and determine their closure.)

You’re welcome to give it a try.  In particular it’d be great if you
could check that ‘device-module-aliases’ returns the right thing on your
machine, as I shown in the example above.

Note that, in addition to that, we could also have a tool to generate a
template ‘operating-system’ declaration.  Let’s say:

  guix system template desktop encrypted-root

would generate a config based on the desktop config but with the right
‘initrd-modules’.

Feedback & suggestions welcome!

Ludo’.

Ludovic Courtès (5):
  Add (guix glob).
  linux-modules: Add 'device-module-aliases' and related procedures.
  linux-initrd: Separate file system module logic.
  system: Add 'initrd-modules' field.
  guix system: Check for the lack of modules in the initrd.

 Makefile.am                   |   4 +-
 doc/guix.texi                 |  42 ++++++++---
 gnu/build/linux-modules.scm   | 161 +++++++++++++++++++++++++++++++++++++++++-
 gnu/system.scm                |   8 +++
 gnu/system/install.scm        |   7 +-
 gnu/system/linux-initrd.scm   |  94 ++++++++++++++----------
 gnu/system/mapped-devices.scm |  53 ++++++++++----
 gnu/tests/install.scm         |  11 ++-
 guix/glob.scm                 |  97 +++++++++++++++++++++++++
 guix/scripts/system.scm       |  67 +++++++++++++++---
 tests/glob.scm                |  58 +++++++++++++++
 11 files changed, 519 insertions(+), 83 deletions(-)
 create mode 100644 guix/glob.scm
 create mode 100644 tests/glob.scm

-- 
2.16.2

[bug#30629] [PATCH 1/5] Add (guix glob).

[Ludovic Courtès]

* guix/glob.scm, tests/glob.scm: New files.
* Makefile.am (MODULES): Add guix/glob.scm.
(SCM_TESTS): Add tests/glob.scm.
---
 Makefile.am    |  4 ++-
 guix/glob.scm  | 97 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 tests/glob.scm | 58 +++++++++++++++++++++++++++++++++++
 3 files changed, 158 insertions(+), 1 deletion(-)
 create mode 100644 guix/glob.scm
 create mode 100644 tests/glob.scm

diff --git a/Makefile.am b/Makefile.am
index e2c940ca8..6556799e6 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Andreas Enge <andreas@enge.fr>
 # Copyright © 2015, 2017 Alex Kost <alezost@gmail.com>
 # Copyright © 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
@@ -83,6 +83,7 @@ MODULES =					\
   guix/gnu-maintenance.scm			\
   guix/upstream.scm				\
   guix/licenses.scm				\
+  guix/glob.scm					\
   guix/git.scm					\
   guix/graph.scm				\
   guix/cache.scm				\
@@ -314,6 +315,7 @@ SCM_TESTS =					\
   tests/substitute.scm				\
   tests/builders.scm				\
   tests/derivations.scm				\
+  tests/glob.scm				\
   tests/grafts.scm				\
   tests/ui.scm					\
   tests/records.scm				\
diff --git a/guix/glob.scm b/guix/glob.scm
new file mode 100644
index 000000000..4fc5173ac
--- /dev/null
+++ b/guix/glob.scm
@@ -0,0 +1,97 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix glob)
+  #:use-module (ice-9 match)
+  #:export (compile-glob-pattern
+            glob-match?))
+
+;;; Commentary:
+;;;
+;;; This is a minimal implementation of "glob patterns" (info "(libc)
+;;; Globbbing").  It is currently limited to simple patterns and does not
+;;; support braces and square brackets, for instance.
+;;;
+;;; Code:
+
+(define (wildcard-indices str)
+  "Return the list of indices in STR where wildcards can be found."
+  (let loop ((index 0)
+             (result '()))
+    (if (= index (string-length str))
+        (reverse result)
+        (loop (+ 1 index)
+              (case (string-ref str index)
+                ((#\? #\*) (cons index result))
+                (else      result))))))
+
+(define (compile-glob-pattern str)
+  "Return an sexp that represents the compiled form of STR, a glob pattern
+such as \"foo*\" or \"foo??bar\"."
+  (define flatten
+    (match-lambda
+      (((? string? str)) str)
+      (x x)))
+
+  (let loop ((index   0)
+             (indices (wildcard-indices str))
+             (result '()))
+    (match indices
+      (()
+       (flatten (cond ((zero? index)
+                       (list str))
+                      ((= index (string-length str))
+                       (reverse result))
+                      (else
+                       (reverse (cons (string-drop str index)
+                                      result))))))
+      ((wildcard-index . rest)
+       (let ((wildcard (match (string-ref str wildcard-index)
+                         (#\? '?)
+                         (#\* '*))))
+         (match (substring str index wildcard-index)
+           (""  (loop (+ 1 wildcard-index)
+                      rest
+                      (cons wildcard result)))
+           (str (loop (+ 1 wildcard-index)
+                      rest
+                      (cons* wildcard str result)))))))))
+
+(define (glob-match? pattern str)
+  "Return true if STR matches PATTERN, a compiled glob pattern as returned by
+'compile-glob-pattern'."
+  (let loop ((pattern pattern)
+             (str str))
+   (match pattern
+     ((? string? literal) (string=? literal str))
+     (((? string? one))   (string=? one str))
+     (('*)  #t)
+     (('?) (= 1 (string-length str)))
+     (()    #t)
+     (('* suffix . rest)
+      (match (string-contains str suffix)
+        (#f    #f)
+        (index (loop rest
+                     (string-drop str
+                                  (+ index (string-length suffix)))))))
+     (('? . rest)
+      (and (>= (string-length str) 1)
+           (loop rest (string-drop str 1))))
+     ((prefix . rest)
+      (and (string-prefix? prefix str)
+           (loop rest (string-drop str (string-length prefix))))))))
diff --git a/tests/glob.scm b/tests/glob.scm
new file mode 100644
index 000000000..033eeb10f
--- /dev/null
+++ b/tests/glob.scm
@@ -0,0 +1,58 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-glob)
+  #:use-module (guix glob)
+  #:use-module (srfi srfi-64))
+
+\f
+(test-begin "glob")
+
+(test-equal "compile-glob-pattern, no wildcards"
+  "foo"
+  (compile-glob-pattern "foo"))
+
+(test-equal "compile-glob-pattern, Kleene star"
+  '("foo" * "bar")
+  (compile-glob-pattern "foo*bar"))
+
+(test-equal "compile-glob-pattern, question mark"
+  '(? "foo" *)
+  (compile-glob-pattern "?foo*"))
+
+(test-assert "literal match"
+  (let ((pattern (compile-glob-pattern "foo")))
+    (and (glob-match? pattern "foo")
+         (not (glob-match? pattern "foobar"))
+         (not (glob-match? pattern "barfoo")))))
+
+(test-assert "trailing star"
+  (let ((pattern (compile-glob-pattern "foo*")))
+    (and (glob-match? pattern "foo")
+         (glob-match? pattern "foobar")
+         (not (glob-match? pattern "xfoo")))))
+
+(test-assert "question marks"
+  (let ((pattern (compile-glob-pattern "foo??bar")))
+    (and (glob-match? pattern "fooxxbar")
+         (glob-match? pattern "fooZZbar")
+         (not (glob-match? pattern "foobar"))
+         (not (glob-match? pattern "fooxxxbar"))
+         (not (glob-match? pattern "fooxxbarzz")))))
+
+(test-end "glob")
-- 
2.16.2

[bug#30629] [PATCH 1/5] Add (guix glob).

[Marius Bakke]

[-- Attachment #1: Type: text/plain, Size: 7938 bytes --]

Ludovic Courtès <ludo@gnu.org> writes:

> * guix/glob.scm, tests/glob.scm: New files.
> * Makefile.am (MODULES): Add guix/glob.scm.
> (SCM_TESTS): Add tests/glob.scm.
> ---
>  Makefile.am    |  4 ++-
>  guix/glob.scm  | 97 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
>  tests/glob.scm | 58 +++++++++++++++++++++++++++++++++++
>  3 files changed, 158 insertions(+), 1 deletion(-)
>  create mode 100644 guix/glob.scm
>  create mode 100644 tests/glob.scm
>
> diff --git a/Makefile.am b/Makefile.am
> index e2c940ca8..6556799e6 100644
> --- a/Makefile.am
> +++ b/Makefile.am
> @@ -1,5 +1,5 @@
>  # GNU Guix --- Functional package management for GNU
> -# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
> +# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
>  # Copyright © 2013 Andreas Enge <andreas@enge.fr>
>  # Copyright © 2015, 2017 Alex Kost <alezost@gmail.com>
>  # Copyright © 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
> @@ -83,6 +83,7 @@ MODULES =					\
>    guix/gnu-maintenance.scm			\
>    guix/upstream.scm				\
>    guix/licenses.scm				\
> +  guix/glob.scm					\
>    guix/git.scm					\
>    guix/graph.scm				\
>    guix/cache.scm				\
> @@ -314,6 +315,7 @@ SCM_TESTS =					\
>    tests/substitute.scm				\
>    tests/builders.scm				\
>    tests/derivations.scm				\
> +  tests/glob.scm				\
>    tests/grafts.scm				\
>    tests/ui.scm					\
>    tests/records.scm				\
> diff --git a/guix/glob.scm b/guix/glob.scm
> new file mode 100644
> index 000000000..4fc5173ac
> --- /dev/null
> +++ b/guix/glob.scm
> @@ -0,0 +1,97 @@
> +;;; GNU Guix --- Functional package management for GNU
> +;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
> +;;;
> +;;; This file is part of GNU Guix.
> +;;;
> +;;; GNU Guix is free software; you can redistribute it and/or modify it
> +;;; under the terms of the GNU General Public License as published by
> +;;; the Free Software Foundation; either version 3 of the License, or (at
> +;;; your option) any later version.
> +;;;
> +;;; GNU Guix is distributed in the hope that it will be useful, but
> +;;; WITHOUT ANY WARRANTY; without even the implied warranty of
> +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +;;; GNU General Public License for more details.
> +;;;
> +;;; You should have received a copy of the GNU General Public License
> +;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (guix glob)
> +  #:use-module (ice-9 match)
> +  #:export (compile-glob-pattern
> +            glob-match?))
> +
> +;;; Commentary:
> +;;;
> +;;; This is a minimal implementation of "glob patterns" (info "(libc)
> +;;; Globbbing").  It is currently limited to simple patterns and does not
          ^^^
This made my brain stutter :-)

> +;;; support braces and square brackets, for instance.
> +;;;
> +;;; Code:
> +
> +(define (wildcard-indices str)
> +  "Return the list of indices in STR where wildcards can be found."
> +  (let loop ((index 0)
> +             (result '()))
> +    (if (= index (string-length str))
> +        (reverse result)
> +        (loop (+ 1 index)
> +              (case (string-ref str index)
> +                ((#\? #\*) (cons index result))
> +                (else      result))))))
> +
> +(define (compile-glob-pattern str)
> +  "Return an sexp that represents the compiled form of STR, a glob pattern
> +such as \"foo*\" or \"foo??bar\"."
> +  (define flatten
> +    (match-lambda
> +      (((? string? str)) str)
> +      (x x)))
> +
> +  (let loop ((index   0)
> +             (indices (wildcard-indices str))
> +             (result '()))
> +    (match indices
> +      (()
> +       (flatten (cond ((zero? index)
> +                       (list str))
> +                      ((= index (string-length str))
> +                       (reverse result))
> +                      (else
> +                       (reverse (cons (string-drop str index)
> +                                      result))))))
> +      ((wildcard-index . rest)
> +       (let ((wildcard (match (string-ref str wildcard-index)
> +                         (#\? '?)
> +                         (#\* '*))))
> +         (match (substring str index wildcard-index)
> +           (""  (loop (+ 1 wildcard-index)
> +                      rest
> +                      (cons wildcard result)))
> +           (str (loop (+ 1 wildcard-index)
> +                      rest
> +                      (cons* wildcard str result)))))))))
> +
> +(define (glob-match? pattern str)
> +  "Return true if STR matches PATTERN, a compiled glob pattern as returned by
> +'compile-glob-pattern'."
> +  (let loop ((pattern pattern)
> +             (str str))
> +   (match pattern
> +     ((? string? literal) (string=? literal str))
> +     (((? string? one))   (string=? one str))
> +     (('*)  #t)
> +     (('?) (= 1 (string-length str)))
> +     (()    #t)
> +     (('* suffix . rest)
> +      (match (string-contains str suffix)
> +        (#f    #f)
> +        (index (loop rest
> +                     (string-drop str
> +                                  (+ index (string-length suffix)))))))
> +     (('? . rest)
> +      (and (>= (string-length str) 1)
> +           (loop rest (string-drop str 1))))
> +     ((prefix . rest)
> +      (and (string-prefix? prefix str)
> +           (loop rest (string-drop str (string-length prefix))))))))
> diff --git a/tests/glob.scm b/tests/glob.scm
> new file mode 100644
> index 000000000..033eeb10f
> --- /dev/null
> +++ b/tests/glob.scm
> @@ -0,0 +1,58 @@
> +;;; GNU Guix --- Functional package management for GNU
> +;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
> +;;;
> +;;; This file is part of GNU Guix.
> +;;;
> +;;; GNU Guix is free software; you can redistribute it and/or modify it
> +;;; under the terms of the GNU General Public License as published by
> +;;; the Free Software Foundation; either version 3 of the License, or (at
> +;;; your option) any later version.
> +;;;
> +;;; GNU Guix is distributed in the hope that it will be useful, but
> +;;; WITHOUT ANY WARRANTY; without even the implied warranty of
> +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +;;; GNU General Public License for more details.
> +;;;
> +;;; You should have received a copy of the GNU General Public License
> +;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (test-glob)
> +  #:use-module (guix glob)
> +  #:use-module (srfi srfi-64))
> +
> +\f
> +(test-begin "glob")
> +
> +(test-equal "compile-glob-pattern, no wildcards"
> +  "foo"
> +  (compile-glob-pattern "foo"))
> +
> +(test-equal "compile-glob-pattern, Kleene star"
> +  '("foo" * "bar")
> +  (compile-glob-pattern "foo*bar"))
> +
> +(test-equal "compile-glob-pattern, question mark"
> +  '(? "foo" *)
> +  (compile-glob-pattern "?foo*"))
> +
> +(test-assert "literal match"
> +  (let ((pattern (compile-glob-pattern "foo")))
> +    (and (glob-match? pattern "foo")
> +         (not (glob-match? pattern "foobar"))
> +         (not (glob-match? pattern "barfoo")))))
> +
> +(test-assert "trailing star"
> +  (let ((pattern (compile-glob-pattern "foo*")))
> +    (and (glob-match? pattern "foo")
> +         (glob-match? pattern "foobar")
> +         (not (glob-match? pattern "xfoo")))))
> +
> +(test-assert "question marks"
> +  (let ((pattern (compile-glob-pattern "foo??bar")))
> +    (and (glob-match? pattern "fooxxbar")
> +         (glob-match? pattern "fooZZbar")
> +         (not (glob-match? pattern "foobar"))
> +         (not (glob-match? pattern "fooxxxbar"))
> +         (not (glob-match? pattern "fooxxbarzz")))))
> +
> +(test-end "glob")
> -- 
> 2.16.2

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#30629] [PATCH 1/5] Add (guix glob).

[Danny Milosavljevic]

> +;;; This is a minimal implementation of "glob patterns" (info "(libc)
> +;;; Globbbing").  It is currently limited to simple patterns and does not
> +;;; support braces and square brackets, for instance.

According to kmod-24 libkmod/libkmod-index.c kmod only supports "?" "*" "[" "]".

So we'd still have to implement "[", "]"

[bug#30629] [PATCH 1/5] Add (guix glob).

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>> +;;; This is a minimal implementation of "glob patterns" (info "(libc)
>> +;;; Globbbing").  It is currently limited to simple patterns and does not
>> +;;; support braces and square brackets, for instance.
>
> According to kmod-24 libkmod/libkmod-index.c kmod only supports "?" "*" "[" "]".
>
> So we'd still have to implement "[", "]"

Indeed.  I’ll look into it, but preferably after we’ve pushed this
initial round if that’s OK.

Ludo’.

[bug#30629] [PATCH 1/5] Add (guix glob).

[Danny Milosavljevic]

There are 48 usb-storage devices using [].  Other than that no one (in Linux 4.15.4).

[bug#30629] [PATCH 1/5] Add (guix glob).

[Danny Milosavljevic]

Since this (guix glob) and its tests are new files and we are pretty sure we are going to need them, let's push it to master now.

I've tested it using linux-boot so it should be fine ([] should be added later).

+(define (compile-glob-pattern str)
[...]

Add a comment in the front that this pattern is just for saving space only:

>           (""  (loop (+ 1 wildcard-index)
+                      rest
+                      (cons wildcard result)))


LGTM!

[bug#30629] [PATCH 2/5] linux-modules: Add 'device-module-aliases' and related procedures.

[Ludovic Courtès]

* gnu/build/linux-modules.scm (readlink*, stat->device-major)
(stat->device-minor): New procedures.
(%not-slash): New variable.
(read-uevent, device-module-aliases, read-module-aliases)
(current-alias-file, known-module-aliases, matching-modules): New
procedures.
---
 gnu/build/linux-modules.scm | 161 +++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 159 insertions(+), 2 deletions(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 5ca7bf8e3..51b3e0871 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -19,6 +19,7 @@
 
 (define-module (gnu build linux-modules)
   #:use-module (guix elf)
+  #:use-module (guix glob)
   #:use-module (guix build syscalls)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
@@ -26,6 +27,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
   #:export (dot-ko
             ensure-dot-ko
             module-dependencies
@@ -34,7 +36,11 @@
             module-loaded?
             load-linux-module*
 
-            current-module-debugging-port))
+            current-module-debugging-port
+
+            device-module-aliases
+            known-module-aliases
+            matching-modules))
 
 ;;; Commentary:
 ;;;
@@ -213,4 +219,155 @@ appears in BLACK-LIST are not loaded."
              (or (and recursive? (= EEXIST (system-error-errno args)))
                  (apply throw args)))))))
 
+\f
+;;;
+;;; Device modules.
+;;;
+
+;; Copied from (guix utils).  FIXME: Factorize.
+(define (readlink* file)
+  "Call 'readlink' until the result is not a symlink."
+  (define %max-symlink-depth 50)
+
+  (let loop ((file  file)
+             (depth 0))
+    (define (absolute target)
+      (if (absolute-file-name? target)
+          target
+          (string-append (dirname file) "/" target)))
+
+    (if (>= depth %max-symlink-depth)
+        file
+        (call-with-values
+            (lambda ()
+              (catch 'system-error
+                (lambda ()
+                  (values #t (readlink file)))
+                (lambda args
+                  (let ((errno (system-error-errno args)))
+                    (if (or (= errno EINVAL))
+                        (values #f file)
+                        (apply throw args))))))
+          (lambda (success? target)
+            (if success?
+                (loop (absolute target) (+ depth 1))
+                file))))))
+
+;; See 'major' and 'minor' in <sys/sysmacros.h>.
+
+(define (stat->device-major st)
+  (ash (logand #xfff00 (stat:rdev st)) -8))
+
+(define (stat->device-minor st)
+  (logand #xff (stat:rdev st)))
+
+(define %not-slash
+  (char-set-complement (char-set #\/)))
+
+(define (read-uevent port)
+  "Read a /sys 'uevent' file from PORT and return an alist where each car is a
+key such as 'MAJOR or 'DEVTYPE and each cdr is the corresponding value."
+  (let loop ((result '()))
+    (match (read-line port)
+      ((? eof-object?)
+       (reverse result))
+      (line
+       (loop (cons (key=value->pair line) result))))))
+
+(define (device-module-aliases device)
+  "Return the list of module aliases required by DEVICE, a /dev file name, as
+in this example:
+
+  (device-module-aliases \"/dev/sda\")
+  => (\"scsi:t-0x00\" \"pci:v00008086d00009D03sv0000103Csd000080FAbc01sc06i01\")
+
+The modules corresponding to these aliases can then be found using
+'matching-modules'."
+  ;; The approach is adapted from
+  ;; <https://unix.stackexchange.com/questions/97676/how-to-find-the-driver-module-associated-with-a-device-on-linux>.
+  (let* ((st        (stat device))
+         (type      (stat:type st))
+         (major     (stat->device-major st))
+         (minor     (stat->device-minor st))
+         (sys-name  (string-append "/sys/dev/"
+                                   (case type
+                                     ((block-special) "block")
+                                     ((char-special)  "char")
+                                     (else (symbol->string type)))
+                                   "/" (number->string major) ":"
+                                   (number->string minor)))
+         (directory (canonicalize-path (readlink* sys-name))))
+    (let loop ((components (string-tokenize directory %not-slash))
+               (aliases    '()))
+      (match components
+        (("sys" "devices" _)
+         (reverse aliases))
+        ((head ... _)
+         (let ((uevent (string-append (string-join components "/" 'prefix)
+                                      "/uevent")))
+           (if (file-exists? uevent)
+               (let ((props (call-with-input-file uevent read-uevent)))
+                 (match (assq-ref props 'MODALIAS)
+                   (#f    (loop head aliases))
+                   (alias (loop head (cons alias aliases)))))
+               (loop head aliases))))))))
+
+(define (read-module-aliases port)
+  "Read from PORT data in the Linux 'modules.alias' file format.  Return a
+list of alias/module pairs where each alias is a glob pattern as like the
+result of:
+
+  (compile-glob-pattern \"scsi:t-0x01*\")
+
+and each module is a module name like \"snd_hda_intel\"."
+  (define (comment? str)
+    (string-prefix? "#" str))
+
+  (define (tokenize str)
+    ;; Lines have the form "alias ALIAS MODULE", where ALIAS can contain
+    ;; whitespace.  This is why we don't use 'string-tokenize'.
+    (let* ((str   (string-trim-both str))
+           (left  (string-index str #\space))
+           (right (string-rindex str #\space)))
+      (list (string-take str left)
+            (string-trim-both (substring str left right))
+            (string-trim-both (string-drop str right)))))
+
+  (let loop ((aliases '()))
+    (match (read-line port)
+      ((? eof-object?)
+       (reverse aliases))
+      ((? comment?)
+       (loop aliases))
+      (line
+       (match (tokenize line)
+         (("alias" alias module)
+          (loop (alist-cons (compile-glob-pattern alias) module
+                            aliases)))
+         (()                                      ;empty line
+          (loop aliases)))))))
+
+(define (current-alias-file)
+  "Return the absolute file name of the default 'modules.alias' file."
+  (string-append (or (getenv "LINUX_MODULE_DIRECTORY")
+                     "/run/booted-system/kernel/lib/modules")
+                 "/" (utsname:release (uname))
+                 "/" "modules.alias"))
+
+(define* (known-module-aliases #:optional (alias-file (current-alias-file)))
+  "Return the list of alias/module pairs read from ALIAS-FILE.  Each alias is
+actually a pattern."
+  (call-with-input-file alias-file read-module-aliases))
+
+(define* (matching-modules alias
+                           #:optional (known-aliases (known-module-aliases)))
+  "Return the list of modules that match ALIAS according to KNOWN-ALIASES.
+ALIAS is a string like \"scsi:t-0x00\" as returned by
+'device-module-aliases'."
+  (filter-map (match-lambda
+                ((pattern . module)
+                 (and (glob-match? pattern alias)
+                      module)))
+              known-aliases))
+
 ;;; linux-modules.scm ends here
-- 
2.16.2

[bug#30629] [PATCH 2/5] linux-modules: Add 'device-module-aliases' and related procedures.

[Danny Milosavljevic]

It can happen that matching-modules returns the same module multiple times...

[bug#30629] [PATCH 2/5] linux-modules: Add 'device-module-aliases' and related procedures.

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> It can happen that matching-modules returns the same module multiple times...

Rather, several aliases can map to the same module, but I think that’s OK.

Ludo’.

[bug#30629] [PATCH 2/5] linux-modules: Add 'device-module-aliases' and related procedures.

[Danny Milosavljevic]

On Tue, 27 Feb 2018 21:55:41 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> Danny Milosavljevic <dannym@scratchpost.org> skribis:
> 
> > It can happen that matching-modules returns the same module multiple times...  
> 
> Rather, several aliases can map to the same module, but I think that’s OK.
> 
> Ludo’.

No, I had it that the same modalias (i.e. /sys/devices/.../modalias content) mapped twice to ahci.

That's why there's a delete-duplicates contraption in my latest patch :)

[bug#30629] [PATCH 2/5] linux-modules: Add 'device-module-aliases' and related procedures.

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> On Tue, 27 Feb 2018 21:55:41 +0100
> ludo@gnu.org (Ludovic Courtès) wrote:
>
>> Danny Milosavljevic <dannym@scratchpost.org> skribis:
>> 
>> > It can happen that matching-modules returns the same module multiple times...  
>> 
>> Rather, several aliases can map to the same module, but I think that’s OK.
>> 
>> Ludo’.
>
> No, I had it that the same modalias (i.e. /sys/devices/.../modalias content) mapped twice to ahci.
>
> That's why there's a delete-duplicates contraption in my latest patch :)

Well OK, ‘delete-duplicates’ is fine.  :-)

Ludo’.

[bug#30629] [PATCH 3/5] linux-initrd: Separate file system module logic.

[Ludovic Courtès]

* gnu/system/linux-initrd.scm (vhash, lookup-procedure): New macros.
(file-system-type-modules, file-system-modules): New procedures.
(base-initrd)[cifs-modules, virtio-9p-modules]: Remove.
[file-system-type-predicate]: Remove.
Use 'file-system-modules' instead of 'find' +
'file-system-type-predicate'.
---
 gnu/system/linux-initrd.scm | 60 +++++++++++++++++++++++++++------------------
 1 file changed, 36 insertions(+), 24 deletions(-)

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 330438bce..830445ac8 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -39,6 +39,7 @@
   #:use-module (gnu system mapped-devices)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (expression->initrd
@@ -242,6 +243,40 @@ FILE-SYSTEMS."
           (list btrfs-progs/static)
           '())))
 
+(define-syntax vhash                              ;TODO: factorize
+  (syntax-rules (=>)
+    "Build a vhash with the given key/value mappings."
+    ((_)
+     vlist-null)
+    ((_ (key others ... => value) rest ...)
+     (vhash-cons key value
+                 (vhash (others ... => value) rest ...)))
+    ((_ (=> value) rest ...)
+     (vhash rest ...))))
+
+(define-syntax lookup-procedure
+  (syntax-rules (else)
+    "Return a procedure that lookups keys in the given dictionary."
+    ((_ mapping ... (else default))
+     (let ((table (vhash mapping ...)))
+       (lambda (key)
+         (match (vhash-assoc key table)
+           (#f    default)
+           (value value)))))))
+
+(define file-system-type-modules
+  ;; Given a file system type, return the list of modules it needs.
+  (lookup-procedure ("cifs" => '("md4" "ecb" "cifs"))
+                    ("9p" => '("9p" "9pnet_virtio"))
+                    ("btrfs" => '("btrfs"))
+                    ("iso9660" => '("isofs"))
+                    (else '())))
+
+(define (file-system-modules file-systems)
+  "Return the list of Linux modules needed to mount FILE-SYSTEMS."
+  (append-map (compose file-system-type-modules file-system-type)
+              file-systems))
+
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
@@ -272,18 +307,6 @@ loaded at boot time in the order in which they appear."
     '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
       "virtio_console"))
 
-  (define cifs-modules
-    ;; Modules needed to mount CIFS file systems.
-    '("md4" "ecb" "cifs"))
-
-  (define virtio-9p-modules
-    ;; Modules for the 9p paravirtualized file system.
-    '("9p" "9pnet_virtio"))
-
-  (define (file-system-type-predicate type)
-    (lambda (fs)
-      (string=? (file-system-type fs) type)))
-
   (define linux-modules
     ;; Modules added to the initrd and loaded from the initrd.
     `("ahci"                                  ;for SATA controllers
@@ -298,18 +321,7 @@ loaded at boot time in the order in which they appear."
       ,@(if (or virtio? qemu-networking?)
             virtio-modules
             '())
-      ,@(if (find (file-system-type-predicate "cifs") file-systems)
-            cifs-modules
-            '())
-      ,@(if (find (file-system-type-predicate "9p") file-systems)
-            virtio-9p-modules
-            '())
-      ,@(if (find (file-system-type-predicate "btrfs") file-systems)
-            '("btrfs")
-            '())
-      ,@(if (find (file-system-type-predicate "iso9660") file-systems)
-            '("isofs")
-            '())
+      ,@(file-system-modules file-systems)
       ,@(if volatile-root?
             '("overlay")
             '())
-- 
2.16.2

[bug#30629] [PATCH 3/5] linux-initrd: Separate file system module logic.

[Danny Milosavljevic]

LGTM!

[bug#30629] [PATCH 4/5] system: Add 'initrd-modules' field.

[Ludovic Courtès]

* gnu/system.scm (<operating-system>)[initrd-modules]: New field.
(operating-system-initrd-file): Pass #:linux-modules to 'make-initrd'.
* gnu/system/linux-initrd.scm (default-initrd-modules): New procedure.
(%base-initrd-modules): New macro.
(base-initrd): Add #:linux-modules and honor it.
* gnu/system/install.scm (embedded-installation-os): Use
'initrd-modules' instead of 'initrd'.
* gnu/tests/install.scm (%raid-root-os): Likewise.
* doc/guix.texi (operating-system Reference): Add 'initrd-modules'.
(Initial RAM Disk): Document it.  Adjust example to not use
 #:extra-modules.
---
 doc/guix.texi               | 42 +++++++++++++++++++++++++++++++++---------
 gnu/system.scm              |  8 ++++++++
 gnu/system/install.scm      |  7 ++-----
 gnu/system/linux-initrd.scm | 34 ++++++++++++++++++++++------------
 gnu/tests/install.scm       | 11 +++++------
 5 files changed, 70 insertions(+), 32 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f9d7e13e2..74f2fee3d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8845,11 +8845,16 @@ the command-line of the kernel---e.g., @code{("console=ttyS0")}.
 @item @code{bootloader}
 The system bootloader configuration object.  @xref{Bootloader Configuration}.
 
+@item @code{initrd-modules} (default: @code{%base-initrd-modules})
+@cindex initrd
+@cindex initial RAM disk
+The list of Linux kernel modules that need to be available in the
+initial RAM disk.  @xref{Initial RAM Disk}.
+
 @item @code{initrd} (default: @code{base-initrd})
-@cindex initrd
-@cindex initial RAM disk
-A two-argument monadic procedure that returns an initial RAM disk for
-the Linux kernel.  @xref{Initial RAM Disk}.
+A monadic procedure that returns an initial RAM disk for the Linux
+kernel.  This field is provided to support low-level customization and
+should rarely be needed for casual use.  @xref{Initial RAM Disk}.
 
 @item @code{firmware} (default: @var{%base-firmware})
 @cindex firmware
@@ -18849,7 +18854,27 @@ root file system as well as an initialization script.  The latter is
 responsible for mounting the real root file system, and for loading any
 kernel modules that may be needed to achieve that.
 
-The @code{initrd} field of an @code{operating-system} declaration allows
+The @code{initrd-modules} field of an @code{operating-system}
+declaration allows you to specify Linux-libre kernel modules that must
+be available in the initrd.  In particular, this is where you would list
+modules needed to actually drive the hard disk where your root partition
+is---although the default value of @code{initrd-modules} should cover
+most use cases.  For example, assuming you need the @code{megaraid_sas}
+module in addition to the default modules to be able to access your root
+file system, you would write:
+
+@example
+(operating-system
+  ;; @dots{}
+  (initrd-modules (cons "megaraid_sas" %base-initrd-modules)))
+@end example
+
+@defvr {Scheme Variable} %base-initrd-modules
+This is the list of kernel modules included in the initrd by default.
+@end defvr
+
+Furthermore, if you need lower-level customization, the @code{initrd}
+field of an @code{operating-system} declaration allows
 you to specify which initrd you would like to use.  The @code{(gnu
 system linux-initrd)} module provides three ways to build an initrd: the
 high-level @code{base-initrd} procedure and the low-level
@@ -18862,11 +18887,10 @@ system declaration like this:
 
 @example
 (initrd (lambda (file-systems . rest)
-          ;; Create a standard initrd that has modules "foo.ko"
-          ;; and "bar.ko", as well as their dependencies, in
-          ;; addition to the modules available by default.
+          ;; Create a standard initrd but set up networking
+          ;; with the parameters QEMU expects by default.
           (apply base-initrd file-systems
-                 #:extra-modules '("foo" "bar")
+                 #:qemu-networking? #t
                  rest)))
 @end example
 
diff --git a/gnu/system.scm b/gnu/system.scm
index 71beee825..4a77877fa 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -74,6 +74,7 @@
             operating-system-kernel
             operating-system-kernel-file
             operating-system-kernel-arguments
+            operating-system-initrd-modules
             operating-system-initrd
             operating-system-users
             operating-system-groups
@@ -152,8 +153,13 @@ booted from ROOT-DEVICE"
                     (default '()))                ; list of gexps/strings
   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
 
+
   (initrd operating-system-initrd                 ; (list fs) -> M derivation
           (default base-initrd))
+  (initrd-modules operating-system-initrd-modules ; list of strings
+                  (thunked)                       ; it's system-dependent
+                  (default %base-initrd-modules))
+
   (firmware operating-system-firmware             ; list of packages
             (default %base-firmware))
 
@@ -846,6 +852,8 @@ hardware-related operations as necessary when booting a Linux container."
 
   (mlet %store-monad ((initrd (make-initrd boot-file-systems
                                            #:linux (operating-system-kernel os)
+                                           #:linux-modules
+                                           (operating-system-initrd-modules os)
                                            #:mapped-devices mapped-devices)))
     (return (file-append initrd "/initrd"))))
 
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index b61660b4b..37c591ec3 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
@@ -396,10 +396,7 @@ The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
     (kernel-arguments
      (cons (string-append "console=" tty)
            (operating-system-user-kernel-arguments installation-os)))
-    (initrd (lambda (fs . rest)
-              (apply base-initrd fs
-                     #:extra-modules extra-modules
-                     rest)))))
+    (initrd-modules (append extra-modules %base-initrd-modules))))
 
 (define beaglebone-black-installation-os
   (embedded-installation-os u-boot-beaglebone-black-bootloader
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 830445ac8..e7f97bb88 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -43,6 +43,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (expression->initrd
+            %base-initrd-modules
             raw-initrd
             file-system-packages
             base-initrd))
@@ -277,14 +278,31 @@ FILE-SYSTEMS."
   (append-map (compose file-system-type-modules file-system-type)
               file-systems))
 
+(define* (default-initrd-modules #:optional (system (%current-system)))
+  "Return the list of modules included in the initrd by default."
+  `("ahci"                                  ;for SATA controllers
+    "usb-storage" "uas"                     ;for the installation image etc.
+    "usbhid" "hid-generic" "hid-apple"      ;keyboards during early boot
+    "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
+    "nls_iso8859-1"                            ;for `mkfs.fat`, et.al
+    ,@(if (string-match "^(x86_64|i[3-6]86)-" system)
+          '("pata_acpi" "pata_atiixp"    ;for ATA controllers
+            "isci")                      ;for SAS controllers like Intel C602
+          '())))
+
+(define-syntax %base-initrd-modules
+  ;; This more closely matches our naming convention.
+  (identifier-syntax (default-initrd-modules)))
+
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (linux-modules '())
                       (mapped-devices '())
                       qemu-networking?
                       volatile-root?
                       (virtio? #t)
-                      (extra-modules '())
+                      (extra-modules '())         ;deprecated
                       (on-error 'debug))
   "Return a monadic derivation that builds a generic initrd, with kernel
 modules taken from LINUX.  FILE-SYSTEMS is a list of file-systems to be
@@ -307,17 +325,9 @@ loaded at boot time in the order in which they appear."
     '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
       "virtio_console"))
 
-  (define linux-modules
+  (define linux-modules*
     ;; Modules added to the initrd and loaded from the initrd.
-    `("ahci"                                  ;for SATA controllers
-      "usb-storage" "uas"                     ;for the installation image etc.
-      "usbhid" "hid-generic" "hid-apple"      ;keyboards during early boot
-      "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
-      "nls_iso8859-1"                            ;for `mkfs.fat`, et.al
-      ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
-            '("pata_acpi" "pata_atiixp"    ;for ATA controllers
-              "isci")                      ;for SAS controllers like Intel C602
-            '())
+    `(,@linux-modules
       ,@(if (or virtio? qemu-networking?)
             virtio-modules
             '())
@@ -332,7 +342,7 @@ loaded at boot time in the order in which they appear."
 
   (raw-initrd file-systems
               #:linux linux
-              #:linux-modules linux-modules
+              #:linux-modules linux-modules*
               #:mapped-devices mapped-devices
               #:helper-packages helper-packages
               #:qemu-networking? qemu-networking?
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 3ac4a579d..e3bb1b46a 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -565,11 +565,10 @@ where /gnu lives on a separate partition.")
                  (bootloader grub-bootloader)
                  (target "/dev/vdb")))
     (kernel-arguments '("console=ttyS0"))
-    (initrd (lambda (file-systems . rest)
-              ;; Add a kernel module for RAID-0 (aka. "stripe").
-              (apply base-initrd file-systems
-                     #:extra-modules '("raid0")
-                     rest)))
+
+    ;; Add a kernel module for RAID-0 (aka. "stripe").
+    (initrd-modules (cons "raid0" %base-initrd-modules))
+
     (mapped-devices (list (mapped-device
                            (source (list "/dev/vda2" "/dev/vda3"))
                            (target "/dev/md0")
-- 
2.16.2

[bug#30629] [PATCH 4/5] system: Add 'initrd-modules' field.

[Danny Milosavljevic]

> --- a/gnu/system.scm
> +++ b/gnu/system.scm
> @@ -74,6 +74,7 @@
>              operating-system-kernel
>              operating-system-kernel-file
>              operating-system-kernel-arguments
> +            operating-system-initrd-modules
>              operating-system-initrd
>              operating-system-users
>              operating-system-groups
> @@ -152,8 +153,13 @@ booted from ROOT-DEVICE"
>                      (default '()))                ; list of gexps/strings
>    (bootloader operating-system-bootloader)        ; <bootloader-configuration>
>  
> +

Nitpick: Another empty line ? :)

Otherwise LGTM!

[bug#30629] [PATCH 5/5] guix system: Check for the lack of modules in the initrd.

[Ludovic Courtès]

* guix/scripts/system.scm (check-mapped-devices): Take an OS instead of
a list of <mapped-device>.  Pass #:needed-for-boot? and #:initrd-modules
to CHECK.
(check-initrd-modules): New procedure.
(perform-action): Move 'check-mapped-devices' call first.  Add call to
'check-initrd-modules'.
* gnu/system/mapped-devices.scm (check-device-initrd-modules): New
procedure.
(check-luks-device): Add #:initrd-modules and #:needed-for-boot?.  Use
them to call 'check-device-initrd-modules'.
---
 gnu/system/mapped-devices.scm | 53 +++++++++++++++++++++++++---------
 guix/scripts/system.scm       | 67 ++++++++++++++++++++++++++++++++++++-------
 2 files changed, 96 insertions(+), 24 deletions(-)

diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index dbeb0d343..5ceb5e658 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2017 Mark H Weaver <mhw@netris.org>
 ;;;
@@ -30,9 +30,12 @@
   #:use-module (gnu services shepherd)
   #:use-module (gnu system uuid)
   #:autoload   (gnu build file-systems) (find-partition-by-luks-uuid)
+  #:autoload   (gnu build linux-modules)
+                 (device-module-aliases matching-modules)
   #:autoload   (gnu packages cryptsetup) (cryptsetup-static)
   #:autoload   (gnu packages linux) (mdadm-static)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
@@ -151,19 +154,43 @@
   #~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
                     "close" #$target)))
 
-(define (check-luks-device md)
+(define (check-device-initrd-modules device linux-modules location)
+  "Raise an error if DEVICE needs modules beyond LINUX-MODULES to operate.
+DEVICE must be a \"/dev\" file name."
+  (let ((modules (delete-duplicates
+                  (append-map matching-modules
+                              (device-module-aliases device)))))
+    (unless (every (cute member <> linux-modules) modules)
+      (raise (condition
+              (&message
+               (message (format #f (G_ "you may need these modules \
+in the initrd for ~a:~{ ~a~}")
+                                device modules)))
+              (&error-location
+               (location (source-properties->location location))))))))
+
+(define* (check-luks-device md #:key
+                            needed-for-boot?
+                            (initrd-modules '())
+                            #:allow-other-keys
+                            #:rest rest)
   "Ensure the source of MD is valid."
-  (let ((source (mapped-device-source md)))
-    (or (not (uuid? source))
-        (not (zero? (getuid)))
-        (find-partition-by-luks-uuid (uuid-bytevector source))
-        (raise (condition
-                (&message
-                 (message (format #f (G_ "no LUKS partition with UUID '~a'")
-                                  (uuid->string source))))
-                (&error-location
-                 (location (source-properties->location
-                            (mapped-device-location md)))))))))
+  (let ((source   (mapped-device-source md))
+        (location (mapped-device-location md)))
+    (or (not (zero? (getuid)))
+        (if (uuid? source)
+            (match (find-partition-by-luks-uuid (uuid-bytevector source))
+              (#f
+               (raise (condition
+                       (&message
+                        (message (format #f (G_ "no LUKS partition with UUID '~a'")
+                                         (uuid->string source))))
+                       (&error-location
+                        (location (source-properties->location
+                                   (mapped-device-location md)))))))
+              ((? string? device)
+               (check-device-initrd-modules device initrd-modules location)))
+            (check-device-initrd-modules source initrd-modules location)))))
 
 (define luks-device-mapping
   ;; The type of LUKS mapped devices.
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 999ffb010..ff322ec78 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -41,6 +41,10 @@
   #:use-module (gnu build install)
   #:autoload   (gnu build file-systems)
                  (find-partition-by-label find-partition-by-uuid)
+  #:autoload   (gnu build linux-modules)
+                 (device-module-aliases matching-modules)
+  #:autoload   (gnu system linux-initrd)
+                 (base-initrd default-initrd-modules)
   #:use-module (gnu system)
   #:use-module (gnu bootloader)
   #:use-module (gnu system file-systems)
@@ -624,21 +628,61 @@ any, are available.  Raise an error if they're not."
       ;; Better be safe than sorry.
       (exit 1))))
 
-(define (check-mapped-devices mapped-devices)
+(define (check-mapped-devices os)
   "Check that each of MAPPED-DEVICES is valid according to the 'check'
 procedure of its type."
+  (define boot-mapped-devices
+    (operating-system-boot-mapped-devices os))
+
+  (define (needed-for-boot? md)
+    (memq md boot-mapped-devices))
+
+  (define initrd-modules
+    (operating-system-initrd-modules os))
+
   (for-each (lambda (md)
               (let ((check (mapped-device-kind-check
                             (mapped-device-type md))))
                 ;; We expect CHECK to raise an exception with a detailed
-                ;; '&message' if something goes wrong, but handle the case
-                ;; where it just returns #f.
-                (unless (check md)
-                  (leave (G_ "~a: invalid '~a' mapped device~%")
-                         (location->string
-                          (source-properties->location
-                           (mapped-device-location md)))))))
-            mapped-devices))
+                ;; '&message' if something goes wrong.
+                (check md
+                       #:needed-for-boot? (needed-for-boot? md)
+                       #:initrd-modules initrd-modules)))
+            (operating-system-mapped-devices os)))
+
+(define (check-initrd-modules os)
+  "Check that modules needed by 'needed-for-boot' file systems in OS are
+available in the initrd.  Note that mapped devices are responsible for
+checking this by themselves in their 'check' procedure."
+  (define (file-system-/dev fs)
+    (let ((device (file-system-device fs)))
+      (match (file-system-title fs)
+        ('device device)
+        ('uuid   (find-partition-by-uuid device))
+        ('label  (find-partition-by-label device)))))
+
+  (define (check-device device location)
+    (let ((modules (delete-duplicates
+                    (append-map matching-modules
+                                (device-module-aliases device)))))
+      (unless (every (cute member <> (operating-system-initrd-modules os))
+                     modules)
+        (raise (condition
+                (&message
+                 (message (format #f (G_ "you need these modules \
+in the initrd for ~a:~{ ~a~}")
+                                  device modules)))
+                (&error-location (location location)))))))
+
+  (define file-systems
+    (filter file-system-needed-for-boot?
+            (operating-system-file-systems os)))
+
+  (for-each (lambda (fs)
+              (check-device (file-system-/dev fs)
+                            (source-properties->location
+                             (file-system-location fs))))
+            file-systems))
 
 \f
 ;;;
@@ -730,9 +774,10 @@ output when building a system derivation, such as a disk image."
   ;; instantiating a broken configuration.  Assume that we can only check if
   ;; running as root.
   (when (memq action '(init reconfigure))
+    (check-mapped-devices os)
     (when (zero? (getuid))
-      (check-file-system-availability (operating-system-file-systems os)))
-    (check-mapped-devices (operating-system-mapped-devices os)))
+      (check-file-system-availability (operating-system-file-systems os))
+      (check-initrd-modules os)))
 
   (mlet* %store-monad
       ((sys       (system-derivation-for-action os action
-- 
2.16.2

[bug#30629] [PATCH 5/5] guix system: Check for the lack of modules in the initrd.

[Danny Milosavljevic]

LGTM!

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 2263 bytes --]

Hi Ludo,

>   1. ‘device-module-aliases’ returns the empty list for /dev/dm-0, which
>      is a LUKS device on my laptop.  I’m not sure what it would take to
>      have it return “dm-crypt”, etc.  Same for RAID devices.

Hmm...  I don't know either.

(same happens on my machine)

>   2. Let’s assume you have: (initrd-modules '("a")).  ‘guix system’
>      could report that module “b” is missing, even if “b” is actually a
>      dependency of “a” and will therefore be automatically included in
>      the initrd.  I think that’s an acceptable limitation (fixing it is
>      non-trivial since we’d ideally need to build the target kernel so
>      we can inspect its modules and determine their closure.)

I think that's okay.

> You’re welcome to give it a try.  In particular it’d be great if you
> could check that ‘device-module-aliases’ returns the right thing on your
> machine, as I shown in the example above.

scheme@(guile-user)> (device-module-aliases "/dev/sda5")
$1 = ("scsi:t-0x00" "pci:v00008086d00009C03sv000017AAsd00002214bc01sc06i01")
scheme@(guile-user)> (device-module-aliases "/dev/sda1")
$2 = ("scsi:t-0x00" "pci:v00008086d00009C03sv000017AAsd00002214bc01sc06i01")

> Note that, in addition to that, we could also have a tool to generate a
> template ‘operating-system’ declaration.  Let’s say:
> 
>   guix system template desktop encrypted-root
> 
> would generate a config based on the desktop config but with the right
> ‘initrd-modules’.

Sounds like a good idea!

P.S. I just integrated my patchset (v5) and your patchset and have a working system
with pure guile initrd (modprobe is in guile, too).  I ran basic system tests and
also rebooted my machine with it :)

Attached is the integration patch, so let's just review the patchsets
as normal and then push both and then push the integration patch.

I'm not sure about the module resolution order, first use the aliases or first
use the real module files?

The Linux modules should be much more under control then...

(zip file attached for convenience, but please ignore duplicates - it contains the same
patches as in the other E-Mails already - except for patch context)

[-- Attachment #2: 0013-linux-initrd-Make-modprobe-pure-Guile.patch --]
[-- Type: text/x-patch, Size: 6394 bytes --]

From ffd464d540943e221636f7c63bcd22f4370803ae Mon Sep 17 00:00:00 2001
From: Danny Milosavljevic <dannym@scratchpost.org>
Date: Tue, 27 Feb 2018 21:25:27 +0100
Subject: [FIXME 13/13] linux-initrd: Make modprobe pure-Guile.
Tags: patch

* gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe.
* gnu/system/linux-initrd.scm (%modprobe-exp): New variable.
(expression->initrd): Delete parameter "kmod".  Use the above.
(raw-initrd): Replace kmod's default by "kmod".
(base-initrd): Replace kmod's default by "kmod".
Add LINUX-MODULES parameter again because it fell out before (?).
---
 gnu/build/linux-initrd.scm  |  7 +++---
 gnu/system/linux-initrd.scm | 57 ++++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 55 insertions(+), 9 deletions(-)

diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index 6356007df..f54d7102d 100644
--- a/gnu/build/linux-initrd.scm
+++ b/gnu/build/linux-initrd.scm
@@ -107,7 +107,7 @@ This is similar to what 'compiled-file-name' in (system base compile) does."
 
 (define* (build-initrd output
                        #:key
-                       guile init kmod linux-module-directory
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -132,9 +132,10 @@ REFERENCES-GRAPHS."
     (readlink "proc/self/exe")
 
     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
-    (when kmod
+    (when modprobe
       (mkdir-p "sbin")
-      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
 
     ;; Make modules available as /lib/modules so modprobe finds them.
     (mkdir-p "lib")
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 1cb73b310..0e8ce3590 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,12 +56,51 @@
 ;;;
 ;;; Code:
 
+(define* (%modprobe-exp linux-module-directory)
+  (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 (lookup module)
+          (let* ((name (ensure-dot-ko module))
+                 (linux-release-module-directory
+                  (string-append "/lib/modules/" (utsname:release (uname))
+                                 "/"))
+                 (path (string-append linux-release-module-directory name)))
+            (if (file-exists? path)
+                path
+                ;; FIXME: Make safe.
+                (match (delete-duplicates (matching-modules module
+                        (known-module-aliases
+                         (string-append linux-release-module-directory
+                                        "modules.alias"))))
+                 (() #f)
+                 ((x-name) (lookup x-name))
+                 ((_ ...)
+                  (error "several modules by that name"
+                         name))))))
+        (define option-spec
+         '((quiet    (single-char #\q) (value #f))))
+        (define options (getopt-long (command-line) option-spec))
+        (for-each
+          (lambda (option)
+            (match option
+             ((() modules ...)
+              (for-each
+                (lambda (module)
+                  (let ((file-name (lookup module)))
+                    (when file-name
+                      (load-linux-module* file-name
+                                          #:lookup-module lookup))))
+                modules))
+             (_ #t)))
+          options))))
 
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
-                             kmod
                              linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
@@ -75,6 +114,10 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (define init
     (program-file "init" exp #:guile guile))
 
+  (define modprobe
+    (program-file "modprobe"
+     (%modprobe-exp linux-module-directory) #:guile guile))
+
   (define builder
     (with-imported-modules (source-module-closure
                             '((gnu build linux-initrd)))
@@ -98,14 +141,16 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        #:kmod #$kmod
+                        #:modprobe #$modprobe
                         #:linux-module-directory #$linux-module-directory
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        ;; Copy everything INIT and MODPROBE refer to into the initrd.
+                        #:references-graphs '("init-closure"
+                                              "modprobe-closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
 
   (gexp->derivation name builder
-                    #:references-graphs `(("closure" ,init))))
+                    #:references-graphs `(("init-closure" ,init)
+                                          ("modprobe-closure" ,modprobe))))
 
 (define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -247,7 +292,6 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
-   #:kmod kmod
    #:linux-module-directory kodir
    #:name "raw-initrd"))
 
@@ -321,6 +365,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (linux-modules '())
                       (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?

[-- Attachment #3: a.zip --]
[-- Type: application/zip, Size: 28597 bytes --]

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Ludovic Courtès]

Hi Danny!

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>>   1. ‘device-module-aliases’ returns the empty list for /dev/dm-0, which
>>      is a LUKS device on my laptop.  I’m not sure what it would take to
>>      have it return “dm-crypt”, etc.  Same for RAID devices.
>
> Hmm...  I don't know either.

I browsed kmod in search of code that does that but couldn’t find it.
Do you know of another source for such things?

>>   2. Let’s assume you have: (initrd-modules '("a")).  ‘guix system’
>>      could report that module “b” is missing, even if “b” is actually a
>>      dependency of “a” and will therefore be automatically included in
>>      the initrd.  I think that’s an acceptable limitation (fixing it is
>>      non-trivial since we’d ideally need to build the target kernel so
>>      we can inspect its modules and determine their closure.)
>
> I think that's okay.

OK.

>> You’re welcome to give it a try.  In particular it’d be great if you
>> could check that ‘device-module-aliases’ returns the right thing on your
>> machine, as I shown in the example above.
>
> scheme@(guile-user)> (device-module-aliases "/dev/sda5")
> $1 = ("scsi:t-0x00" "pci:v00008086d00009C03sv000017AAsd00002214bc01sc06i01")
> scheme@(guile-user)> (device-module-aliases "/dev/sda1")
> $2 = ("scsi:t-0x00" "pci:v00008086d00009C03sv000017AAsd00002214bc01sc06i01")

Looks good.

> P.S. I just integrated my patchset (v5) and your patchset and have a working system
> with pure guile initrd (modprobe is in guile, too).  I ran basic system tests and
> also rebooted my machine with it :)

Damn it you’re too fast.  :-)  That’s good news though!

> Attached is the integration patch, so let's just review the patchsets
> as normal and then push both and then push the integration patch.

Do you think we could squash things to avoid the kmod-static
intermediate step when we push?

> I'm not sure about the module resolution order, first use the aliases or first
> use the real module files?

In what part?

> The Linux modules should be much more under control then...

Yes!

> From ffd464d540943e221636f7c63bcd22f4370803ae Mon Sep 17 00:00:00 2001
> From: Danny Milosavljevic <dannym@scratchpost.org>
> Date: Tue, 27 Feb 2018 21:25:27 +0100
> Subject: [FIXME 13/13] linux-initrd: Make modprobe pure-Guile.
> Tags: patch
>
> * gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe.
> * gnu/system/linux-initrd.scm (%modprobe-exp): New variable.
> (expression->initrd): Delete parameter "kmod".  Use the above.
> (raw-initrd): Replace kmod's default by "kmod".
> (base-initrd): Replace kmod's default by "kmod".
> Add LINUX-MODULES parameter again because it fell out before (?).

Awesome.  :-)

> +(define* (%modprobe-exp linux-module-directory)
> +  (with-imported-modules (source-module-closure
> +                          '((gnu build linux-modules)))
> +    #~(begin

I’d rather change that to ‘modprobe-program’ and have it return:

  (program-file "modprobe" (with-import-modules … #~(begin …)))

mostly because “file-like objects” compose better than arbitrary pieces
of code.

> +        (use-modules (gnu build linux-modules) (ice-9 getopt-long)
> +                     (ice-9 match) (srfi srfi-1))
> +        (define (lookup module)
> +          (let* ((name (ensure-dot-ko module))
> +                 (linux-release-module-directory
> +                  (string-append "/lib/modules/" (utsname:release (uname))
> +                                 "/"))

I think we can’t use ‘uname’ here because that returns info about the
build host, not about the machine and kernel we’re deploying.

> +                 (path (string-append linux-release-module-directory name)))

s/path/directory/ :-)

> +            (if (file-exists? path)
> +                path
> +                ;; FIXME: Make safe.
> +                (match (delete-duplicates (matching-modules module
> +                        (known-module-aliases
> +                         (string-append linux-release-module-directory
> +                                        "modules.alias"))))
> +                 (() #f)
> +                 ((x-name) (lookup x-name))
> +                 ((_ ...)
> +                  (error "several modules by that name"
> +                         name))))))
> +        (define option-spec
> +         '((quiet    (single-char #\q) (value #f))))
> +        (define options (getopt-long (command-line) option-spec))
> +        (for-each
> +          (lambda (option)
> +            (match option
> +             ((() modules ...)
> +              (for-each
> +                (lambda (module)
> +                  (let ((file-name (lookup module)))
> +                    (when file-name
> +                      (load-linux-module* file-name
> +                                          #:lookup-module lookup))))

Should it be an error when MODULE could not be found?

Also, indentation should be like:

  (for-each (lambda (option)
              …
              (for-each (lambda (module)
                          …)))
            …)

>  (define* (base-initrd file-systems
>                        #:key
>                        (linux linux-libre)
> +                      (linux-modules '())
>                        (kmod kmod-minimal/static)
>                        (mapped-devices '())
>                        qemu-networking?

We no longer need #:kmod here.

Thank you!

Ludo’.

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

Hi Ludo,

> > I'm not sure about the module resolution order, first use the aliases or first
> > use the real module files?  
> 
> In what part?

modprobe.  It can either get "pci:024215325233" or "ahci".  The first is an alias
and the latter eventually resolves to a file "ahci.ko".

> I’d rather change that to ‘modprobe-program’ and have it return:
> 
>   (program-file "modprobe" (with-import-modules … #~(begin …)))

Sure.

> I think we can’t use ‘uname’ here because that returns info about the
> build host, not about the machine and kernel we’re deploying.

Yeah, oops.  I tried to avoid having it in the first place, but kmod
(depmod) insists.  Sigh...  I'll add a hack...

> > +                 (path (string-append linux-release-module-directory name)))  
> 
> s/path/directory/ :-)

It's the full path to the module file (a regular file).  "name" was taken :)

It's rewrite it so it says file-name...

> > +                (match (delete-duplicates (matching-modules module
                             ^^^^^^^^^^^^^^^^^ :)

> Should it be an error when MODULE could not be found?

Yes,

I will properly implement the modprobe "-q" option.

(What Linux does is call this thing with "-q" which means modprobe shouldn't
print anything)

After that, we can reinstate error printing.

Right now it's a little disconcerting if it prints the errors - I tried it :)

> Also, indentation should be like:
> 
>   (for-each (lambda (option)
>               …
>               (for-each (lambda (module)
>                           …)))
>             …)

Sure.

> >  (define* (base-initrd file-systems
> >                        #:key
> >                        (linux linux-libre)
> > +                      (linux-modules '())
> >                        (kmod kmod-minimal/static)
> >                        (mapped-devices '())
> >                        qemu-networking?  
> 
> We no longer need #:kmod here.

Yes, we do.  It doesn't end up in the finished initrd file directly, 
but flat-linux-module-directory uses it (now) in order to invoke depmod -
otherwise we don't have modules.alias etc.

Also, when I replace kmod-minimal/static by kmod I get a massive number of
test failures.  What I'm trying to say, in this case I think
having an intermediate step kmod-minimal/static is the least of the evils...

[bug#30638] [WIP v2] linux-initrd: Make modprobe pure-Guile.

[Danny Milosavljevic]

* gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe.
* gnu/system/linux-initrd.scm (%modprobe-exp): New variable.
(expression->initrd): Delete parameter "kmod".  Use the above.
(raw-initrd): Replace kmod's default by "kmod".
(base-initrd): Replace kmod's default by "kmod".
Add LINUX-MODULES parameter again because it fell out before (?).
---
 gnu/build/linux-initrd.scm  |  7 ++---
 gnu/system/linux-initrd.scm | 65 ++++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 63 insertions(+), 9 deletions(-)

diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index 6356007df..f54d7102d 100644
--- a/gnu/build/linux-initrd.scm
+++ b/gnu/build/linux-initrd.scm
@@ -107,7 +107,7 @@ This is similar to what 'compiled-file-name' in (system base compile) does."
 
 (define* (build-initrd output
                        #:key
-                       guile init kmod linux-module-directory
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -132,9 +132,10 @@ REFERENCES-GRAPHS."
     (readlink "proc/self/exe")
 
     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
-    (when kmod
+    (when modprobe
       (mkdir-p "sbin")
-      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
 
     ;; Make modules available as /lib/modules so modprobe finds them.
     (mkdir-p "lib")
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 1cb73b310..16b1383fa 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,12 +56,60 @@
 ;;;
 ;;; Code:
 
+(define* (%modprobe linux-module-directory #:key
+                    (guile %guile-static-stripped))
+  (program-file "modprobe"
+    (with-imported-modules (source-module-closure
+                            '((gnu build linux-modules)))
+      #~(begin
+          (use-modules (gnu build linux-modules) (ice-9 getopt-long)
+                       (ice-9 match) (srfi srfi-1) (ice-9 ftw))
+          (define (find-only-entry directory)
+            (match (scandir directory)
+             (("." ".." basename)
+              (string-append directory "/" basename))))
+          (define (lookup module)
+            (let* ((linux-release-module-directory
+                    (find-only-entry (string-append "/lib/modules")))
+                   (file-name (string-append linux-release-module-directory
+                                             "/" (ensure-dot-ko module))))
+              (if (file-exists? file-name)
+                  file-name
+                  ;; FIXME: Make safe.
+                  (match (delete-duplicates (matching-modules module
+                          (known-module-aliases
+                           (string-append linux-release-module-directory
+                                          "/modules.alias"))))
+                   (()
+                    (error "no module by that name" module))
+                   ((x-name) (lookup x-name))
+                   ((_ ...)
+                    (error "several modules by that name"
+                           module))))))
+          (define option-spec
+           '((quiet    (single-char #\q) (value #f))))
+          (define options
+            (getopt-long (command-line) option-spec))
+          (when (option-ref options 'quiet #f)
+            (current-error-port (%make-void-port "w"))
+            (current-output-port (%make-void-port "w")))
+          (for-each (match-lambda
+                      (('quiet . #t)
+                       #f)
+                      ((() modules ...)
+                       (for-each (lambda (module)
+                                   (let ((file-name (lookup module)))
+                                     (load-linux-module* file-name
+                                                         #:lookup-module
+                                                         lookup)))
+                                 modules)))
+                    options)))
+  #:guile guile))
 
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
-                             kmod
                              linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
@@ -75,6 +123,9 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (define init
     (program-file "init" exp #:guile guile))
 
+  (define modprobe
+    (%modprobe linux-module-directory #:guile guile))
+
   (define builder
     (with-imported-modules (source-module-closure
                             '((gnu build linux-initrd)))
@@ -98,14 +149,16 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        #:kmod #$kmod
+                        #:modprobe #$modprobe
                         #:linux-module-directory #$linux-module-directory
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        ;; Copy everything INIT and MODPROBE refer to into the initrd.
+                        #:references-graphs '("init-closure"
+                                              "modprobe-closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
 
   (gexp->derivation name builder
-                    #:references-graphs `(("closure" ,init))))
+                    #:references-graphs `(("init-closure" ,init)
+                                          ("modprobe-closure" ,modprobe))))
 
 (define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -247,7 +300,6 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
-   #:kmod kmod
    #:linux-module-directory kodir
    #:name "raw-initrd"))
 
@@ -321,6 +373,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (linux-modules '())
                       (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?

[bug#30638] [WIP v2] linux-initrd: Make modprobe pure-Guile.

[Danny Milosavljevic]

> +            (current-error-port (%make-void-port "w"))
> +            (current-output-port (%make-void-port "w")))

Note: For some reason this doesn't suppress (error ...) messages.

[bug#30638] [WIP v3] linux-initrd: Make modprobe pure-Guile.

[Danny Milosavljevic]

* gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe.
* gnu/system/linux-initrd.scm (%modprobe-exp): New variable.
(expression->initrd): Delete parameter "kmod".  Use the above.
(base-initrd): Add LINUX-MODULES parameter again because it fell out before (?)
---
 gnu/build/linux-initrd.scm  |  7 +++--
 gnu/system/linux-initrd.scm | 74 +++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 72 insertions(+), 9 deletions(-)

diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index 6356007df..f54d7102d 100644
--- a/gnu/build/linux-initrd.scm
+++ b/gnu/build/linux-initrd.scm
@@ -107,7 +107,7 @@ This is similar to what 'compiled-file-name' in (system base compile) does."
 
 (define* (build-initrd output
                        #:key
-                       guile init kmod linux-module-directory
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -132,9 +132,10 @@ REFERENCES-GRAPHS."
     (readlink "proc/self/exe")
 
     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
-    (when kmod
+    (when modprobe
       (mkdir-p "sbin")
-      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
 
     ;; Make modules available as /lib/modules so modprobe finds them.
     (mkdir-p "lib")
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 1cb73b310..0ae21882e 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,12 +56,69 @@
 ;;;
 ;;; Code:
 
+(define* (%modprobe linux-module-directory #:key
+                    (guile %guile-static-stripped))
+  (program-file "modprobe"
+    (with-imported-modules (source-module-closure
+                            '((gnu build linux-modules)))
+      #~(begin
+          (use-modules (gnu build linux-modules) (ice-9 getopt-long)
+                       (ice-9 match) (srfi srfi-1) (ice-9 ftw))
+          (define (find-only-entry directory)
+            (match (scandir directory)
+             (("." ".." basename)
+              (string-append directory "/" basename))))
+          (define (lookup module)
+            (let* ((linux-release-module-directory
+                    (find-only-entry (string-append "/lib/modules")))
+                   (file-name (string-append linux-release-module-directory
+                                             "/" (ensure-dot-ko module))))
+              (if (file-exists? file-name)
+                  file-name
+                  (match (delete-duplicates (matching-modules module
+                          (known-module-aliases
+                           (string-append linux-release-module-directory
+                                          "/modules.alias"))))
+                   (()
+                    (error "no module by that name" module))
+                   ((x-name)
+                    (lookup x-name))
+                   ((_ ...)
+                    (error "several modules by that name"
+                           module))))))
+          (define option-spec
+           '((quiet    (single-char #\q) (value #f))))
+          (define options
+            (getopt-long (command-line) option-spec))
+          (when (option-ref options 'quiet #f)
+            (current-error-port (%make-void-port "w"))
+            (current-output-port (%make-void-port "w")))
+          (let ((exit-status 0))
+            (for-each (match-lambda
+                        (('quiet . #t)
+                         #f)
+                        ((() modules ...)
+                         (for-each (lambda (module)
+                                     (catch #t
+                                       (lambda ()
+                                         (let ((file-name (lookup module)))
+                                           (load-linux-module* file-name
+                                                               #:lookup-module
+                                                               lookup)))
+                                       (lambda (key . args)
+                                         (display (cons* key args)
+                                                  (current-error-port))
+                                         (newline (current-error-port))
+                                         (set! exit-status 1))))
+                                   modules)))
+                      options)
+            (exit exit-status))))
+  #:guile guile))
 
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
-                             kmod
                              linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
@@ -75,6 +132,9 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (define init
     (program-file "init" exp #:guile guile))
 
+  (define modprobe
+    (%modprobe linux-module-directory #:guile guile))
+
   (define builder
     (with-imported-modules (source-module-closure
                             '((gnu build linux-initrd)))
@@ -98,14 +158,16 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        #:kmod #$kmod
+                        #:modprobe #$modprobe
                         #:linux-module-directory #$linux-module-directory
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        ;; Copy everything INIT and MODPROBE refer to into the initrd.
+                        #:references-graphs '("init-closure"
+                                              "modprobe-closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
 
   (gexp->derivation name builder
-                    #:references-graphs `(("closure" ,init))))
+                    #:references-graphs `(("init-closure" ,init)
+                                          ("modprobe-closure" ,modprobe))))
 
 (define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -247,7 +309,6 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
-   #:kmod kmod
    #:linux-module-directory kodir
    #:name "raw-initrd"))
 
@@ -321,6 +382,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (linux-modules '())
                       (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?

[bug#30638] [WIP v4] linux-initrd: Make modprobe pure-Guile.

[Danny Milosavljevic]

* gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe.
* gnu/system/linux-initrd.scm (%modprobe-exp): New variable.
(expression->initrd): Delete parameter "kmod".  Use the above.
(base-initrd): Add LINUX-MODULES parameter again because it fell out before (?)
---
 gnu/build/linux-initrd.scm  |  7 ++--
 gnu/system/linux-initrd.scm | 78 +++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 76 insertions(+), 9 deletions(-)

diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index 6356007df..f54d7102d 100644
--- a/gnu/build/linux-initrd.scm
+++ b/gnu/build/linux-initrd.scm
@@ -107,7 +107,7 @@ This is similar to what 'compiled-file-name' in (system base compile) does."
 
 (define* (build-initrd output
                        #:key
-                       guile init kmod linux-module-directory
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -132,9 +132,10 @@ REFERENCES-GRAPHS."
     (readlink "proc/self/exe")
 
     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
-    (when kmod
+    (when modprobe
       (mkdir-p "sbin")
-      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
 
     ;; Make modules available as /lib/modules so modprobe finds them.
     (mkdir-p "lib")
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 1cb73b310..59db128a2 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,12 +56,73 @@
 ;;;
 ;;; Code:
 
+(define* (%modprobe linux-module-directory #:key
+                    (guile %guile-static-stripped))
+  (program-file "modprobe"
+    (with-imported-modules (source-module-closure
+                            '((gnu build linux-modules)))
+      #~(begin
+          (use-modules (gnu build linux-modules) (ice-9 getopt-long)
+                       (ice-9 match) (srfi srfi-1) (ice-9 ftw))
+          (define (find-only-entry directory)
+            (match (scandir directory)
+             (("." ".." basename)
+              (string-append directory "/" basename))))
+          (define (resolve-alias alias)
+            (let* ((linux-release-module-directory
+                    (find-only-entry (string-append "/lib/modules"))))
+              (match (delete-duplicates (matching-modules alias
+                      (known-module-aliases
+                        (string-append linux-release-module-directory
+                                       "/modules.alias"))))
+               (()
+                (error "no alias by that name" alias))
+               (items
+                items))))
+          (define (lookup-module module)
+            (let* ((linux-release-module-directory
+                    (find-only-entry (string-append "/lib/modules")))
+                   (file-name (string-append linux-release-module-directory
+                                             "/" (ensure-dot-ko module))))
+              (if (file-exists? file-name)
+                  file-name
+                  (error "no module file found for module" module))))
+          (define option-spec
+           '((quiet    (single-char #\q) (value #f))))
+          (define options
+            (getopt-long (command-line) option-spec))
+          (when (option-ref options 'quiet #f)
+            (current-error-port (%make-void-port "w"))
+            (current-output-port (%make-void-port "w")))
+          (let ((exit-status 0))
+            (for-each (match-lambda
+                        (('quiet . #t)
+                         #f)
+                        ((() modules ...)
+                         (for-each (lambda (alias)
+                                     (catch #t
+                                       (lambda ()
+                                         (let ((modules (resolve-alias alias)))
+                                           (for-each (lambda (module)
+                                                       (load-linux-module*
+                                                        (lookup-module module)
+                                                        #:lookup-module
+                                                        lookup-module))
+                                                     modules)))
+                                       (lambda (key . args)
+                                         (display (cons* key args)
+                                                  (current-error-port))
+                                         (newline (current-error-port))
+                                         (set! exit-status 1))))
+                                   modules)))
+                      options)
+            (exit exit-status))))
+  #:guile guile))
 
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
-                             kmod
                              linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
@@ -75,6 +136,9 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (define init
     (program-file "init" exp #:guile guile))
 
+  (define modprobe
+    (%modprobe linux-module-directory #:guile guile))
+
   (define builder
     (with-imported-modules (source-module-closure
                             '((gnu build linux-initrd)))
@@ -98,14 +162,16 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        #:kmod #$kmod
+                        #:modprobe #$modprobe
                         #:linux-module-directory #$linux-module-directory
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        ;; Copy everything INIT and MODPROBE refer to into the initrd.
+                        #:references-graphs '("init-closure"
+                                              "modprobe-closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
 
   (gexp->derivation name builder
-                    #:references-graphs `(("closure" ,init))))
+                    #:references-graphs `(("init-closure" ,init)
+                                          ("modprobe-closure" ,modprobe))))
 
 (define (flat-linux-module-directory linux modules kmod)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -247,7 +313,6 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
-   #:kmod kmod
    #:linux-module-directory kodir
    #:name "raw-initrd"))
 
@@ -321,6 +386,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (linux-modules '())
                       (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

On Tue, 27 Feb 2018 23:50:27 +0100
Danny Milosavljevic <dannym@scratchpost.org> wrote:

> > > I'm not sure about the module resolution order, first use the aliases or first
> > > use the real module files?    
> > 
> > In what part?  
> 
> modprobe.  It can either get "pci:024215325233" or "ahci".  The first is an alias
> and the latter eventually resolves to a file "ahci.ko".

kmod-24 does it in this order:

        DBG(ctx, "lookup modules.dep %s\n", alias);
... (if found, stop)
        DBG(ctx, "lookup modules.symbols %s\n", alias);
... (if found, stop)
        DBG(ctx, "lookup install and remove commands %s\n", alias);
... (if found, stop)
        DBG(ctx, "lookup modules.aliases %s\n", alias);
... (if found, stop)
        DBG(ctx, "lookup modules.builtin %s\n", alias);

modules.builtin is just available as modules.builtin.bin, hmmm...

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Ludovic Courtès]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>> > I'm not sure about the module resolution order, first use the aliases or first
>> > use the real module files?  
>> 
>> In what part?
>
> modprobe.  It can either get "pci:024215325233" or "ahci".  The first is an alias
> and the latter eventually resolves to a file "ahci.ko".

I see.  Does it make sense to first look up the name in modules.aliases,
and if that fails, assume it’s a module name?

>> > +                 (path (string-append linux-release-module-directory name)))  
>> 
>> s/path/directory/ :-)
>
> It's the full path to the module file (a regular file).  "name" was taken :)

To avoid ambiguities, the GNU Coding Standards (and Guix) suggest using
the word “path” for search paths, and “file name” (or “file”, or
“directory”) for file/directory names:

  https://www.gnu.org/prep/standards/html_node/GNU-Manuals.html#GNU-Manuals

Really a detail, but I think it’s good to be consistent.

>> >  (define* (base-initrd file-systems
>> >                        #:key
>> >                        (linux linux-libre)
>> > +                      (linux-modules '())
>> >                        (kmod kmod-minimal/static)
>> >                        (mapped-devices '())
>> >                        qemu-networking?  
>> 
>> We no longer need #:kmod here.
>
> Yes, we do.

I mean in the final version we’ll use the (gnu build linux-modules) I
think, so we won’t need kmod anymore.  Or am I missing something?

Thank you!

Ludo’.

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

Hi Ludo,

On Thu, 01 Mar 2018 11:05:33 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> >> >  (define* (base-initrd file-systems
> >> >                        #:key
> >> >                        (linux linux-libre)
> >> > +                      (linux-modules '())
> >> >                        (kmod kmod-minimal/static)
> >> >                        (mapped-devices '())
> >> >                        qemu-networking?    
> >> 
> >> We no longer need #:kmod here.  
> >
> > Yes, we do.  
> 
> I mean in the final version we’ll use the (gnu build linux-modules) I
> think, so we won’t need kmod anymore.  Or am I missing something?

depmod.  It creates the modules.alias in the first place - it won't go away
even after we use (gnu build linux-modules) for looking up stuff in
modules.alias .

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

> Also, when I replace kmod-minimal/static by kmod I get a massive number of
> test failures.  What I'm trying to say, in this case I think
> having an intermediate step kmod-minimal/static is the least of the evils...

To clarify, the other "evils" would be to

* Have a non-working intermediate state pushed to master, or
* Have to push all 14 patches (yours and mine) at the same time - with
overlooked bugs in it hitting us all at once.

I prefer not to do these.

I think it's better to have kmod-minimal-static and my patchset in master
for a week in order to be reasonably sure that the linux-boot.scm
changes do what they are supposed to do (which is essentially the same
as before the patch - just loading no unnecessary modules :P).

Also, loading dm-crypt and raid works just fine with it since the kernel
does it anyway (by calling us back).

My commit message indicated that I used the regular kmod - but I was mistaken
(in the commit message, not the actual source code).
I tried, but it doesn't work (or kmod-minimal-static even build) with the newer
kmod (static), so I changed it back to the older one again.

Also, kmod-minimal (not static) of the newer version doesn't work either (depmod
fails with error code 127 with no message printed anywhere).

The old kmod version is special because it's the last one to officially
support static linking.  Let's just use old kmod-minimal-static as-is until we
figure out what's up with newer ones (I don't have any ideas left about that -
I don't even understand why it needs to be statically linked when, with the
integrated version, kmod doesn't end up in the initrd anyway.
I tried with the integrated version: Error 127).

Did I mention it's great to be able to rollback to the previous system
generation in the grub boot menu?  It's so great!

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Ludovic Courtès]

Howdy!

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>> Also, when I replace kmod-minimal/static by kmod I get a massive number of
>> test failures.  What I'm trying to say, in this case I think
>> having an intermediate step kmod-minimal/static is the least of the evils...
>
> To clarify, the other "evils" would be to
>
> * Have a non-working intermediate state pushed to master, or
> * Have to push all 14 patches (yours and mine) at the same time - with
> overlooked bugs in it hitting us all at once.
>
> I prefer not to do these.

Of course.  What I was suggesting was to push “my” series first, then
rebase “yours” on top of it without the kmod bits since we can now do
without it.

How does that sound?

(I understand it’s somewhat unfair.  I wanted to submit my part before
you started working on the rest, but you’re so fast that I just can’t
keep up.  ;-))

> I think it's better to have kmod-minimal-static and my patchset in master
> for a week in order to be reasonably sure that the linux-boot.scm
> changes do what they are supposed to do (which is essentially the same
> as before the patch - just loading no unnecessary modules :P).
>
> Also, loading dm-crypt and raid works just fine with it since the kernel
> does it anyway (by calling us back).
>
> My commit message indicated that I used the regular kmod - but I was mistaken
> (in the commit message, not the actual source code).
> I tried, but it doesn't work (or kmod-minimal-static even build) with the newer
> kmod (static), so I changed it back to the older one again.
>
> Also, kmod-minimal (not static) of the newer version doesn't work either (depmod
> fails with error code 127 with no message printed anywhere).
>
> The old kmod version is special because it's the last one to officially
> support static linking.  Let's just use old kmod-minimal-static as-is until we
> figure out what's up with newer ones (I don't have any ideas left about that -
> I don't even understand why it needs to be statically linked when, with the
> integrated version, kmod doesn't end up in the initrd anyway.
> I tried with the integrated version: Error 127).

Honestly I feel it’ll be easier to deal with a small pure-Scheme
implementation.

> Did I mention it's great to be able to rollback to the previous system
> generation in the grub boot menu?  It's so great!

:-)

Ludo’.

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

Hi,

On Thu, 01 Mar 2018 14:39:39 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> Of course.  What I was suggesting was to push “my” series first, then
> rebase “yours” on top of it without the kmod bits since we can now do
> without it.

Sure, I'm fine with this.

bug#30629: [PATCH 0/5] Detect missing modules in the initrd

[Ludovic Courtès]

Hello Danny,

I’ve now pushed the whole series, so we can focus on the continuation
now.  :-)

Thanks for reviewing!

Ludo’.

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

Hi Ludo,

I've cloned master and checked it again, everything is fine except for the test failures :->

It's not so bad, don't worry.

------------------------------------------------------------------------------------------------
$ make TESTS=separate-store-os check-system
[...]
Service cow-store has been started.
+ mkdir /mnt/etc
+ cp /etc/target-config.scm /mnt/etc/config.scm
+ guix system init /mnt/etc/config.scm /mnt --no-substitutes
/mnt/etc/config.scm:1:300: error: you need these modules in the initrd for /dev/vdb2: virtio_blk virtio_pci
environment variable `PATH' set to `/gnu/store/hrwkb74sxa9lpfljgi12b5xsaqrcx8x3-qemu-minimal-2.11.1/bin'
QEMU runs as PID 9
connected to QEMU's monitor
read QEMU monitor prompt
connected to guest REPL
marionette is ready

;;; (uname #("Linux" "gnu" "4.15.7-gnu" "#1 SMP 1" "x86_64"))
note: keeping build directory `/tmp/guix-build-installation.drv-1'
builder for `/gnu/store/b4ddq7grgyn48q1j2gw6hah92bvhjymw-installation.drv' failed with exit code 1
@ build-failed /gnu/store/b4ddq7grgyn48q1j2gw6hah92bvhjymw-installation.drv - 1 builder for `/gnu/store/b4ddq7grgyn48q1j2gw6hah92bvhjymw-installation.drv' failed with exit code 1
cannot build derivation `/gnu/store/709x4gzkfdzpnqgsqj7lh35pqnj9vvy5-separate-store-os.drv': 1 dependencies couldn't be built
TOTAL: 1
FAIL: /gnu/store/skxfrvcynva5fwq7w4rg0g8c5qc771lb-separate-store-os
------------------------------------------------------------------------------------------------

I think it's right in that:

/mnt/etc/config.scm:1:300: error: you need these modules in the initrd for /dev/vdb2: virtio_blk virtio_pci

That means the system tests now have to be a little bit aware that they are running in a VM...

Same for separate-home-os and installed-os and maybe others - they are still running.

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

Hmm...

$ make TESTS=iso-image-installer check-system
...
   592:29  2 (map1 _)
   592:17  1 (map1 ("iso9660" "isofs" "overlay"))
In unknown file:
           0 (scm-error misc-error #f "~A ~S ~S" ("module not fo?" ?) ?)

ERROR: In procedure scm-error:
module not found "iso9660.ko" "/gnu/store/lzmq94d47pcgr38kwdmy67x6cd1f9ip4-linux-libre-4.15.7/lib/modules"
note: keeping build directory `/tmp/guix-build-linux-modules.drv-0'
builder for `/gnu/store/minvqnpizvasga2gc68ph488y69vw9w2-linux-modules.drv' failed with exit code 1
@ build-failed /gnu/store/minvqnpizvasga2gc68ph488y69vw9w2-linux-modules.drv - 1 builder for `/gnu/store/minvqnpizvasga2gc68ph488y69vw9w2-linux-modules.drv' failed with exit code 1
cannot build derivation `/gnu/store/cic83a4mlg3kvp3iygmm721rk5lz44ks-init.drv': 1 dependencies couldn't be built

(It's called "isofs" but there are aliases in modules.alias: fs-iso9660, iso9960)

I think now we need to take care about the module key resolution order with modules.alias, modules.builtin and modules.dep.

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> I've cloned master and checked it again, everything is fine except for the test failures :->

Oops!

> It's not so bad, don't worry.
>
> ------------------------------------------------------------------------------------------------
> $ make TESTS=separate-store-os check-system
> [...]
> Service cow-store has been started.
> + mkdir /mnt/etc
> + cp /etc/target-config.scm /mnt/etc/config.scm
> + guix system init /mnt/etc/config.scm /mnt --no-substitutes
> /mnt/etc/config.scm:1:300: error: you need these modules in the initrd for /dev/vdb2: virtio_blk virtio_pci
> environment variable `PATH' set to `/gnu/store/hrwkb74sxa9lpfljgi12b5xsaqrcx8x3-qemu-minimal-2.11.1/bin'
> QEMU runs as PID 9
> connected to QEMU's monitor
> read QEMU monitor prompt
> connected to guest REPL
> marionette is ready
>
> ;;; (uname #("Linux" "gnu" "4.15.7-gnu" "#1 SMP 1" "x86_64"))
> note: keeping build directory `/tmp/guix-build-installation.drv-1'
> builder for `/gnu/store/b4ddq7grgyn48q1j2gw6hah92bvhjymw-installation.drv' failed with exit code 1
> @ build-failed /gnu/store/b4ddq7grgyn48q1j2gw6hah92bvhjymw-installation.drv - 1 builder for `/gnu/store/b4ddq7grgyn48q1j2gw6hah92bvhjymw-installation.drv' failed with exit code 1
> cannot build derivation `/gnu/store/709x4gzkfdzpnqgsqj7lh35pqnj9vvy5-separate-store-os.drv': 1 dependencies couldn't be built
> TOTAL: 1
> FAIL: /gnu/store/skxfrvcynva5fwq7w4rg0g8c5qc771lb-separate-store-os
> ------------------------------------------------------------------------------------------------
>
> I think it's right in that:
>
> /mnt/etc/config.scm:1:300: error: you need these modules in the initrd for /dev/vdb2: virtio_blk virtio_pci

I moved them to ‘%base-initrd-modules’ so that ‘guix system’ knows about
them.  I fixed other issues as well:

  eac026e5c * linux-initrd: Add virtio modules to '%base-initrd-modules'.
  f850e0da8 * system: beaglebone-black: Use 'initrd-modules'.
  5a3716aeb * vm: Add missing modules to the 'expression->derivation-in-linux-vm' initrd.
  3cb3a4e6e * linux-initrd: 'file-system-modules' returns the right module list.

Apologies for the breakage!

Thanks,
Ludo’.

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

> Of course.  What I was suggesting was to push “my” series first, then
> rebase “yours” on top of it without the kmod bits since we 

>can now do
> without it.

Do you plan to implement depmod in Guile?

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>> Of course.  What I was suggesting was to push “my” series first, then
>> rebase “yours” on top of it without the kmod bits since we 
>
>>can now do
>> without it.
>
> Do you plan to implement depmod in Guile?

I’m not sure what you mean exactly.  We have ‘module-dependencies’ and
‘recursive-module-dependencies’ in (gnu build linux-modules) to
determine module dependencies by looking at the ELF files.  AFAICS we
don’t need to generate modules.dep and map files, do we?

Ludo’.

[bug#30629] [PATCH 0/5] Detect missing modules in the initrd

[Danny Milosavljevic]

Hi Ludo,

On Thu, 01 Mar 2018 22:20:09 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> > Do you plan to implement depmod in Guile?  
> 
> I’m not sure what you mean exactly.  We have ‘module-dependencies’ and
> ‘recursive-module-dependencies’ in (gnu build linux-modules) to
> determine module dependencies by looking at the ELF files.  AFAICS we
> don’t need to generate modules.dep and map files, do we?

No, but modules.alias - but I guess we can also generate it and read the
information from the ELF files.

/sys/devices/.../modalias definitely contain aliases like pci:v00343...-
without alias resolving, it won't boot in the integrated version.

[bug#30629] Device mapper modalias

[Danny Milosavljevic]

Hi Ludo,

On Tue, 27 Feb 2018 22:15:31 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> >>   1. ‘device-module-aliases’ returns the empty list for /dev/dm-0, which
> >>      is a LUKS device on my laptop.  I’m not sure what it would take to
> >>      have it return “dm-crypt”, etc.  Same for RAID devices.  
> >
> > Hmm...  I don't know either.  
> 
> I browsed kmod in search of code that does that but couldn’t find it.
> Do you know of another source for such things?

The device mapper for logical devices (/dev/mapper/control) provides ioctls.

scheme@(guile-user)> (device-module-aliases "/dev/mapper/control")
$2 = ()

Sigh...

Also, Linux dm.c lazily modprobes "dm-%s", target_type.

To get target_type as root (warning: getting the table status loads the module):

#include <sys/sysmacros.h>
#include <stdio.h>
#include <stdlib.h>
#include <stddef.h>
#include <assert.h>
#include <linux/dm-ioctl.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/ioctl.h>
#include <fcntl.h>
#include <string.h>

static void xdm_init(struct dm_ioctl* header, unsigned dev, off_t datastart, size_t allsize, unsigned flags) {
        memset(header, 0, sizeof(header));
        header->version[0] = 4;
        header->version[1] = 0;
        header->version[2] = 0;
        header->data_size = allsize;
        header->data_start = datastart;
        header->flags = flags;
        header->dev = dev;
}

struct xdm_devicelist {
        struct dm_ioctl header;
        struct dm_name_list items[100];
};

struct xdm_tablestatus {
        struct dm_ioctl header;
        struct dm_target_spec items[100];
};

int main() {
        int controlfd;
        controlfd = open("/dev/mapper/control", O_RDWR);

	// Retrieve dev major/minor
        struct xdm_devicelist devicelist;
        xdm_init(&devicelist.header, 0, offsetof(struct xdm_devicelist, items), sizeof(devicelist), 0);
        if (ioctl(controlfd, DM_LIST_DEVICES, &devicelist) == -1)
                abort();
        printf("devicelist %s %u\n", devicelist.items[0].name, (unsigned) devicelist.items[0].dev);

	// Get target_type of that device
        struct xdm_tablestatus tablestatus;
        xdm_init(&tablestatus.header, devicelist.items[0].dev, offsetof(struct xdm_tablestatus, items), sizeof(tablestatus), DM_STATUS_TABLE_FLAG);
        tablestatus.header.dev = devicelist.items[0].dev;
        if (ioctl(controlfd, DM_TABLE_STATUS, &tablestatus) == -1) {
                perror("b");
                abort();
        }
        assert(tablestatus.header.target_count == 1);
        printf("target_type %s\n", tablestatus.items[0].target_type); // prints "crypto", hence we should modprobe "dm-crypto".
        printf("XXX %u\n", makedev(253, 0)); // The same
        return 0;
}

Alternatively, there's even a dm-uevent.c for sysfs AND we have enabled it AND it's supposed
to report DM_TARGET - but I can't see it.  Maybe it only does that for events and not for state.

Alternatively, there's also this:

$ udevadm info -q all /dev/dm-0

... which has quite a lot of the info, but not the module name.

[bug#30629] Device mapper modalias

[Danny Milosavljevic]

> Also, Linux dm.c lazily modprobes "dm-%s", target_type.

Very similar for raid and other md stuff (see linux/drivers/md/md.c), just with modprobe

  "md-level%s", clevel

and

  "md-%s", level

and

  "md-cluster".

Values for these placeholders can be found out by examining the raid superblock.

But I think in the long run it would be nice if the RAID setup itself was in
/etc/config.scm (if it isn't already - dunno).

[bug#30629] Device mapper modalias

[Ludovic Courtès]

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> To get target_type as root (warning: getting the table status loads the module):
>
> #include <sys/sysmacros.h>
> #include <stdio.h>
> #include <stdlib.h>
> #include <stddef.h>
> #include <assert.h>
> #include <linux/dm-ioctl.h>
> #include <sys/types.h>
> #include <sys/stat.h>
> #include <sys/ioctl.h>
> #include <fcntl.h>
> #include <string.h>
>
> static void xdm_init(struct dm_ioctl* header, unsigned dev, off_t datastart, size_t allsize, unsigned flags) {
>         memset(header, 0, sizeof(header));
>         header->version[0] = 4;
>         header->version[1] = 0;
>         header->version[2] = 0;
>         header->data_size = allsize;
>         header->data_start = datastart;
>         header->flags = flags;
>         header->dev = dev;
> }
>
> struct xdm_devicelist {
>         struct dm_ioctl header;
>         struct dm_name_list items[100];
> };
>
> struct xdm_tablestatus {
>         struct dm_ioctl header;
>         struct dm_target_spec items[100];
> };
>
> int main() {
>         int controlfd;
>         controlfd = open("/dev/mapper/control", O_RDWR);
>
> 	// Retrieve dev major/minor
>         struct xdm_devicelist devicelist;
>         xdm_init(&devicelist.header, 0, offsetof(struct xdm_devicelist, items), sizeof(devicelist), 0);
>         if (ioctl(controlfd, DM_LIST_DEVICES, &devicelist) == -1)
>                 abort();
>         printf("devicelist %s %u\n", devicelist.items[0].name, (unsigned) devicelist.items[0].dev);
>
> 	// Get target_type of that device
>         struct xdm_tablestatus tablestatus;
>         xdm_init(&tablestatus.header, devicelist.items[0].dev, offsetof(struct xdm_tablestatus, items), sizeof(tablestatus), DM_STATUS_TABLE_FLAG);
>         tablestatus.header.dev = devicelist.items[0].dev;
>         if (ioctl(controlfd, DM_TABLE_STATUS, &tablestatus) == -1) {
>                 perror("b");
>                 abort();
>         }
>         assert(tablestatus.header.target_count == 1);
>         printf("target_type %s\n", tablestatus.items[0].target_type); // prints "crypto", hence we should modprobe "dm-crypto".

Is this target_type/module name mapping always correct?

If so, we could always implement this DM_TABLE_STATUS ioctl and use it,
although if it loads modules as a side effect that’s not great.

> Alternatively, there's even a dm-uevent.c for sysfs AND we have enabled it AND it's supposed
> to report DM_TARGET - but I can't see it.  Maybe it only does that for events and not for state.

Hmm.

> Alternatively, there's also this:
>
> $ udevadm info -q all /dev/dm-0
>
> ... which has quite a lot of the info, but not the module name.

Hmm!  So how do other distros do?  There must be a way to get the module
name no?

Thanks for investigating!

Ludo’.

[bug#30629] Device mapper modalias

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1574 bytes --]

Hi Ludo,

On Thu, 01 Mar 2018 11:11:11 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> >         assert(tablestatus.header.target_count == 1);
> >         printf("target_type %s\n", tablestatus.items[0].target_type); // prints "crypto", hence we should modprobe "dm-crypto".  
> 
> Is this target_type/module name mapping always correct?

Yes - since that's how Linux itself loads the dm modules:

./drivers/md/dm-target.c:       request_module("dm-%s", name);
(and see dm-table.c where once can see that name = target_type of the table structure)

On the other hand, not all dm-*.ko are targets!

> If so, we could always implement this DM_TABLE_STATUS ioctl and use it,
> although if it loads modules as a side effect that’s not great.

> > Alternatively, there's even a dm-uevent.c for sysfs AND we have enabled it AND it's supposed
> > to report DM_TARGET - but I can't see it.  Maybe it only does that for events and not for state.  

I checked it now - it's only reported for events: it reports which target caused
the event.

It would be easy to extend Linux to also report the targets in the state, but
that won't help us with past kernels - and since our use case is mostly
to get the module list starting from an already-running system, it won't
help us.

So I think the ioctl is the best way.

> > $ udevadm info -q all /dev/dm-0
> >
> > ... which has quite a lot of the info, but not the module name.  
> 
> Hmm!  So how do other distros do?  There must be a way to get the module
> name no?

Good question... no idea.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]