;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system linux-initrd)
- #:use-module (guix monads)
- #:use-module (guix store)
#:use-module (guix gexp)
#:use-module (guix utils)
- #:use-module (guix i18n)
#:use-module ((guix store)
#:select (%store-prefix))
#:use-module ((guix derivations)
#:use-module (gnu packages disk)
#:use-module (gnu packages linux)
#:use-module (gnu packages guile)
+ #:use-module ((gnu packages xorg)
+ #:select (console-setup xkeyboard-config))
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
#:use-module (gnu system file-systems)
#:use-module (gnu system mapped-devices)
- #:autoload (gnu build linux-modules)
- (device-module-aliases matching-modules known-module-aliases)
+ #:use-module (gnu system keyboard)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
- #:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
- #:use-module (srfi srfi-34)
- #:use-module (srfi srfi-35)
#:export (expression->initrd
%base-initrd-modules
raw-initrd
file-system-packages
- base-initrd
- check-device-initrd-modules))
+ base-initrd))
\f
;;; Commentary:
(gzip gzip)
(name "guile-initrd")
(system (%current-system)))
- "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
+ "Return as a file-like object a Linux initrd (a gzipped cpio archive)
containing GUILE and that evaluates EXP, a G-expression, upon booting. All
the derivations referenced by EXP are automatically copied to the initrd."
(lambda (port)
(simple-format port "~A\n" #$guile)))
- (build-initrd (string-append #$output "/initrd")
+ (build-initrd (string-append #$output "/initrd.cpio.gz")
#:guile #$guile
#:init #$init
;; Copy everything INIT refers to into the initrd.
#:references-graphs '("closure")
- #:gzip (string-append #$gzip "/bin/gzip")))))
+ #:gzip (string-append #+gzip "/bin/gzip")))))
- (gexp->derivation name builder
- #:references-graphs `(("closure" ,init))))
+ (file-append (computed-file name builder
+ #:options
+ `(#:references-graphs (("closure" ,init))))
+ "/initrd.cpio.gz"))
(define (flat-linux-module-directory linux modules)
"Return a flat directory containing the Linux kernel modules listed in
MODULES and taken from LINUX."
(define build-exp
(with-imported-modules (source-module-closure
- '((guix build utils)
- (gnu build linux-modules)))
+ '((gnu build linux-modules)))
#~(begin
- (use-modules (ice-9 match) (ice-9 regex)
+ (use-modules (gnu build linux-modules)
(srfi srfi-1)
- (guix build utils)
- (gnu build linux-modules))
-
- (define (string->regexp str)
- ;; Return a regexp that matches STR exactly.
- (string-append "^" (regexp-quote str) "$"))
+ (srfi srfi-26))
(define module-dir
(string-append #$linux "/lib/modules"))
- (define (lookup module)
- (let ((name (ensure-dot-ko module)))
- (match (find-files module-dir (string->regexp name))
- ((file)
- file)
- (()
- (error "module not found" name module-dir))
- ((_ ...)
- (error "several modules by that name"
- name module-dir)))))
-
(define modules
- (let ((modules (map lookup '#$modules)))
+ (let* ((lookup (cut find-module-file module-dir <>))
+ (modules (map lookup '#$modules)))
(append modules
(recursive-module-dependencies modules
#:lookup-module lookup))))
(copy-file module
(string-append #$output "/"
(basename module))))
- (delete-duplicates modules)))))
+ (delete-duplicates modules))
+
+ ;; Hyphen or underscore? This database tells us.
+ (write-module-name-database #$output))))
(computed-file "linux-modules" build-exp))
(linux linux-libre)
(linux-modules '())
(mapped-devices '())
+ (keyboard-layout #f)
(helper-packages '())
qemu-networking?
volatile-root?
(on-error 'debug))
- "Return a monadic derivation that builds a raw initrd, with kernel
+ "Return as a file-like object a raw initrd, with kernel
modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
mounted by the initrd, possibly in addition to the root file system specified
on the kernel command line via '--root'. LINUX-MODULES is a list of kernel
HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include
e2fsck/static or other packages needed by the initrd to check root partition.
+When true, KEYBOARD-LAYOUT is a <keyboard-layout> record denoting the desired
+console keyboard layout. This is done before MAPPED-DEVICES are set up and
+before FILE-SYSTEMS are mounted such that, should the user need to enter a
+passphrase or use the REPL, this happens using the intended keyboard layout.
+
When QEMU-NETWORKING? is true, set up networking with the standard QEMU
parameters.
(and #$@device-mapping-commands))
#:linux-modules '#$linux-modules
#:linux-module-directory '#$kodir
+ #:keymap-file #+(and=> keyboard-layout
+ keyboard-layout->console-keymap)
#:qemu-guest-networking? #$qemu-networking?
#:volatile-root? '#$volatile-root?
#:on-error '#$on-error)))
(append-map (compose file-system-type-modules file-system-type)
file-systems))
-(define* (default-initrd-modules #:optional (system (%current-system)))
+(define* (default-initrd-modules
+ #:optional
+ (system (or (%current-target-system)
+ (%current-system))))
"Return the list of modules included in the initrd by default."
(define virtio-modules
;; Modules for Linux para-virtualized devices, for use in QEMU guests.
'("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
- "virtio_console"))
+ "virtio_console" "virtio-rng"))
`("ahci" ;for SATA controllers
"usb-storage" "uas" ;for the installation image etc.
(linux linux-libre)
(linux-modules '())
(mapped-devices '())
+ (keyboard-layout #f)
qemu-networking?
volatile-root?
(extra-modules '()) ;deprecated
(on-error 'debug))
- "Return a monadic derivation that builds a generic initrd, with kernel
+ "Return as a file-like object a generic initrd, with kernel
modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
mounted by the initrd, possibly in addition to the root file system specified
on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
mappings to realize before FILE-SYSTEMS are mounted.
+When true, KEYBOARD-LAYOUT is a <keyboard-layout> record denoting the desired
+console keyboard layout. This is done before MAPPED-DEVICES are set up and
+before FILE-SYSTEMS are mounted such that, should the user need to enter a
+passphrase or use the REPL, this happens using the intended keyboard layout.
+
QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd.
The initrd is automatically populated with all the kernel modules necessary
,@extra-modules))
(define helper-packages
- (file-system-packages file-systems #:volatile-root? volatile-root?))
+ (append (file-system-packages file-systems
+ #:volatile-root? volatile-root?)
+ (if keyboard-layout
+ (list loadkeys-static)
+ '())))
(raw-initrd file-systems
#:linux linux
#:linux-modules linux-modules*
#:mapped-devices mapped-devices
#:helper-packages helper-packages
+ #:keyboard-layout keyboard-layout
#:qemu-networking? qemu-networking?
#:volatile-root? volatile-root?
#:on-error on-error))
-(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."
- (define aliases
- ;; Attempt to load 'modules.alias' from the current kernel, assuming we're
- ;; on GuixSD, and assuming that corresponds to the kernel we'll be
- ;; installing. Skip the whole thing if that file cannot be read.
- (catch 'system-error
- (lambda ()
- (known-module-aliases))
- (const #f)))
-
- (when aliases
- (let ((modules (delete-duplicates
- (append-map (cut matching-modules <> aliases)
- (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)))
- (&fix-hint
- (hint (format #f (G_ "Try adding them to the
-@code{initrd-modules} field of your @code{operating-system} declaration, along
-these lines:
-
-@example
- (operating-system
- ;; @dots{}
- (initrd-modules (append (list~{ ~s~})
- %base-initrd-modules)))
-@end example\n")
- modules)))
- (&error-location
- (location (source-properties->location location)))))))))
-
;;; linux-initrd.scm ends here
HCoop / jackhill / guix / guix.git / blobdiff