06/08: linux-boot: Load modules and their dependencies, Ã la 'modprobe'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 0e704a2d4ea9b65cde79240f4433296645c5a220
Author: Ludovic Courtès <address@hidden>
Date:   Thu Nov 27 23:59:26 2014 +0100

    linux-boot: Load modules and their dependencies, Ã  la 'modprobe'.
    
    * gnu/build/linux-boot.scm: Use (gnu build linux-modules).
      (load-linux-module*): Remove.
      (boot-system): Add #:linux-module-directory parameter.
      [lookup-module]: New procedure.
      Call 'current-module-debugging-port'.  Pass #:lookup-module to
      'load-linux-module*'.  Map LOOKUP-MODULE on LINUX-MODULES.
    * gnu/system/linux-initrd.scm (base-initrd): Adjust 'boot-system' call
      accordingly.  Adjust #:modules argument as well.
    * gnu/system.scm (operating-system-activation-script)[%modules]: Likewise.
    * gnu/system/vm.scm (expression->derivation-in-linux-vm): Likewise.
---
 gnu/build/linux-boot.scm    |   30 +++++++++++++++---------------
 gnu/system.scm              |    4 +++-
 gnu/system/linux-initrd.scm |    9 +++++----
 gnu/system/vm.scm           |    2 ++
 4 files changed, 25 insertions(+), 20 deletions(-)

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 3bf3268..b2ed1a8 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -26,6 +26,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
   #:use-module (guix build utils)
+  #:use-module (gnu build linux-modules)
   #:use-module (gnu build file-systems)
   #:export (mount-essential-file-systems
             linux-command-line
@@ -34,7 +35,6 @@
             configure-qemu-networking
 
             bind-mount
-            load-linux-module*
             device-number
             boot-system))
 
@@ -218,14 +218,6 @@ networking values.)  Return #t if INTERFACE is up, #f 
otherwise."
 
     (logand (network-interface-flags sock interface) IFF_UP)))
 
-(define (load-linux-module* file)
-  "Load Linux module from FILE, the name of a `.ko' file."
-  (define (slurp module)
-    ;; TODO: Use 'mmap' to reduce memory usage.
-    (call-with-input-file file get-bytevector-all))
-
-  (load-linux-module (slurp file)))
-
 (define (device-number major minor)
   "Return the device number for the device with MAJOR and MINOR, for use as
 the last argument of `mknod'."
@@ -332,16 +324,17 @@ bailing out.~%root contents: ~s~%" (scandir "/"))
 
 (define* (boot-system #:key
                       (linux-modules '())
+                      linux-module-directory
                       qemu-guest-networking?
                       volatile-root?
                       pre-mount
                       (mounts '()))
   "This procedure is meant to be called from an initrd.  Boot a system by
-first loading LINUX-MODULES (a list of absolute file names of '.ko' files),
-then setting up QEMU guest networking if QEMU-GUEST-NETWORKING? is true,
-calling PRE-MOUNT, mounting the file systems specified in MOUNTS, and finally
-booting into the new root if any.  The initrd supports kernel command-line
-options '--load', '--root', and '--repl'.
+first loading LINUX-MODULES (a list of module names) from
+LINUX-MODULE-DIRECTORY, then setting up QEMU guest networking if
+QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file systems
+specified in MOUNTS, and finally booting into the new root if any.  The initrd
+supports kernel command-line options '--load', '--root', and '--repl'.
 
 Mount the root file system, specified by the '--root' command-line argument,
 if any.
@@ -362,6 +355,10 @@ to it are lost."
              mounts)
         "ext4"))
 
+  (define (lookup-module name)
+    (string-append linux-module-directory "/"
+                   (ensure-dot-ko name)))
+
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
 
@@ -376,7 +373,10 @@ to it are lost."
          (start-repl))
 
        (display "loading kernel modules...\n")
-       (for-each load-linux-module* linux-modules)
+       (current-module-debugging-port (current-output-port))
+       (for-each (cut load-linux-module* <>
+                      #:lookup-module lookup-module)
+                 (map lookup-module linux-modules))
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/system.scm b/gnu/system.scm
index 8883d3e..e1ed1a2 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -529,8 +529,10 @@ etc."
   (define %modules
     '((gnu build activation)
       (gnu build linux-boot)
+      (gnu build linux-modules)
       (gnu build file-systems)
-      (guix build utils)))
+      (guix build utils)
+      (guix elf)))
 
   (define (service-activations services)
     ;; Return the activation scripts for SERVICES.
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 71aba1e..8129f90 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -236,14 +236,15 @@ loaded at boot time in the order in which they appear."
          (boot-system #:mounts '#$(map file-system->spec file-systems)
                       #:pre-mount (lambda ()
                                     (and address@hidden))
-                      #:linux-modules (map (lambda (file)
-                                             (string-append #$kodir "/" file))
-                                           '#$linux-modules)
+                      #:linux-modules '#$linux-modules
+                      #:linux-module-directory '#$kodir
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?))
      #:name "base-initrd"
      #:modules '((guix build utils)
                  (gnu build linux-boot)
-                 (gnu build file-systems)))))
+                 (gnu build linux-modules)
+                 (gnu build file-systems)
+                 (guix elf)))))
 
 ;;; linux-initrd.scm ends here
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 07b13de..33ca396 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -104,7 +104,9 @@
                                               '((gnu build vm)
                                                 (gnu build install)
                                                 (gnu build linux-boot)
+                                                (gnu build linux-modules)
                                                 (gnu build file-systems)
+                                                (guix elf)
                                                 (guix build utils)
                                                 (guix build store-copy)))
                                              (guile-for-build