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.
This commit is contained in:
Ludovic Courtès 2014-11-27 23:59:26 +01:00
parent 600c285b63
commit 0e704a2d4e
4 changed files with 25 additions and 20 deletions

View file

@ -26,6 +26,7 @@ (define-module (gnu build linux-boot)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (gnu build linux-modules)
#:use-module (gnu build file-systems) #:use-module (gnu build file-systems)
#:export (mount-essential-file-systems #:export (mount-essential-file-systems
linux-command-line linux-command-line
@ -34,7 +35,6 @@ (define-module (gnu build linux-boot)
configure-qemu-networking configure-qemu-networking
bind-mount bind-mount
load-linux-module*
device-number device-number
boot-system)) boot-system))
@ -218,14 +218,6 @@ (define* (configure-qemu-networking #:optional (interface "eth0"))
(logand (network-interface-flags sock interface) IFF_UP))) (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) (define (device-number major minor)
"Return the device number for the device with MAJOR and MINOR, for use as "Return the device number for the device with MAJOR and MINOR, for use as
the last argument of `mknod'." the last argument of `mknod'."
@ -332,16 +324,17 @@ (define (switch-root root)
(define* (boot-system #:key (define* (boot-system #:key
(linux-modules '()) (linux-modules '())
linux-module-directory
qemu-guest-networking? qemu-guest-networking?
volatile-root? volatile-root?
pre-mount pre-mount
(mounts '())) (mounts '()))
"This procedure is meant to be called from an initrd. Boot a system by "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), first loading LINUX-MODULES (a list of module names) from
then setting up QEMU guest networking if QEMU-GUEST-NETWORKING? is true, LINUX-MODULE-DIRECTORY, then setting up QEMU guest networking if
calling PRE-MOUNT, mounting the file systems specified in MOUNTS, and finally QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file systems
booting into the new root if any. The initrd supports kernel command-line specified in MOUNTS, and finally booting into the new root if any. The initrd
options '--load', '--root', and '--repl'. supports kernel command-line options '--load', '--root', and '--repl'.
Mount the root file system, specified by the '--root' command-line argument, Mount the root file system, specified by the '--root' command-line argument,
if any. if any.
@ -362,6 +355,10 @@ (define root-fs-type
mounts) mounts)
"ext4")) "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 "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n") (display "Use '--repl' for an initrd REPL.\n\n")
@ -376,7 +373,10 @@ (define root-fs-type
(start-repl)) (start-repl))
(display "loading kernel modules...\n") (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? (when qemu-guest-networking?
(unless (configure-qemu-networking) (unless (configure-qemu-networking)

View file

@ -529,8 +529,10 @@ (define (operating-system-activation-script os)
(define %modules (define %modules
'((gnu build activation) '((gnu build activation)
(gnu build linux-boot) (gnu build linux-boot)
(gnu build linux-modules)
(gnu build file-systems) (gnu build file-systems)
(guix build utils))) (guix build utils)
(guix elf)))
(define (service-activations services) (define (service-activations services)
;; Return the activation scripts for SERVICES. ;; Return the activation scripts for SERVICES.

View file

@ -236,14 +236,15 @@ (define device-mapping-commands
(boot-system #:mounts '#$(map file-system->spec file-systems) (boot-system #:mounts '#$(map file-system->spec file-systems)
#:pre-mount (lambda () #:pre-mount (lambda ()
(and #$@device-mapping-commands)) (and #$@device-mapping-commands))
#:linux-modules (map (lambda (file) #:linux-modules '#$linux-modules
(string-append #$kodir "/" file)) #:linux-module-directory '#$kodir
'#$linux-modules)
#:qemu-guest-networking? #$qemu-networking? #:qemu-guest-networking? #$qemu-networking?
#:volatile-root? '#$volatile-root?)) #:volatile-root? '#$volatile-root?))
#:name "base-initrd" #:name "base-initrd"
#:modules '((guix build utils) #:modules '((guix build utils)
(gnu build linux-boot) (gnu build linux-boot)
(gnu build file-systems))))) (gnu build linux-modules)
(gnu build file-systems)
(guix elf)))))
;;; linux-initrd.scm ends here ;;; linux-initrd.scm ends here

View file

@ -104,7 +104,9 @@ (define* (expression->derivation-in-linux-vm name exp
'((gnu build vm) '((gnu build vm)
(gnu build install) (gnu build install)
(gnu build linux-boot) (gnu build linux-boot)
(gnu build linux-modules)
(gnu build file-systems) (gnu build file-systems)
(guix elf)
(guix build utils) (guix build utils)
(guix build store-copy))) (guix build store-copy)))
(guile-for-build (guile-for-build