;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017, 2018 Mark H Weaver <mhw@netris.org>
;;;
(define-module (gnu system mapped-devices)
#:use-module (guix gexp)
#:use-module (guix records)
- #:use-module (guix modules)
+ #:use-module ((guix modules) #:hide (file-name->module-name))
#:use-module (guix i18n)
- #:use-module ((guix utils)
+ #:use-module ((guix diagnostics)
#:select (source-properties->location
+ formatted-message
&fix-hint
&error-location))
#:use-module (gnu services)
#: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 known-module-aliases)
+ (missing-modules)
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:export (mapped-device
mapped-device?
mapped-device-source
(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.
+ (define missing
+ ;; Attempt to determine missing modules.
(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 \
+ (missing-modules device linux-modules))
+
+ ;; If we can't do that (e.g., EPERM), skip the whole thing.
+ (const '())))
+
+ (unless (null? missing)
+ ;; Note: What we suggest here is a list of module names (e.g.,
+ ;; "usb_storage"), not file names (e.g., "usb-storage.ko"). This is
+ ;; OK because we have machinery that accepts both the hyphen and the
+ ;; underscore version.
+ (raise (make-compound-condition
+ (formatted-message (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
+ device missing)
+ (condition
+ (&fix-hint
+ (hint (format #f (G_ "Try adding them to the
@code{initrd-modules} field of your @code{operating-system} declaration, along
these lines:
;; @dots{}
(initrd-modules (append (list~{ ~s~})
%base-initrd-modules)))
-@end example\n")
- modules)))
- (&error-location
- (location (source-properties->location location)))))))))
+@end example
+
+If you think this diagnostic is inaccurate, use the @option{--skip-checks}
+option of @command{guix system}.\n")
+ missing))))
+ (condition
+ (&error-location
+ (location (source-properties->location location))))))))
\f
;;;
(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)))))))
+ (raise (make-compound-condition
+ (formatted-message (G_ "no LUKS partition with UUID '~a'")
+ (uuid->string source))
+ (condition
+ (&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)))))