mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-11 13:49:23 -05:00
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:
parent
600c285b63
commit
0e704a2d4e
4 changed files with 25 additions and 20 deletions
|
@ -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)
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue