summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/install.scm2
-rw-r--r--gnu/system/linux-initrd.scm36
-rw-r--r--gnu/system/mapped-devices.scm19
-rw-r--r--gnu/system/vm.scm14
4 files changed, 46 insertions, 25 deletions
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 37c591ec3a..97f5abe0b6 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -133,7 +133,7 @@ the given target.")
(stop #~(lambda (target)
;; Delete the temporary directory, but leave everything
;; mounted as there may still be processes using it since
- ;; 'user-processes' doesn't depend on us. The 'user-unmount'
+ ;; 'user-processes' doesn't depend on us. The 'user-file-systems'
;; service will unmount TARGET eventually.
(delete-file-recursively
(string-append target #$%backing-directory))))))))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index e0cb59c009..1eb5f5130d 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -24,6 +24,7 @@
#: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)
@@ -37,16 +38,22 @@
#: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)
#: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))
+ base-initrd
+ check-device-initrd-modules))
;;; Commentary:
@@ -343,4 +350,31 @@ loaded at boot time in the order in which they appear."
#: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."
+ (let ((modules (delete-duplicates
+ (append-map matching-modules
+ (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
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 5ceb5e658c..e6ac635231 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -29,9 +29,9 @@
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system uuid)
+ #:use-module ((gnu system linux-initrd)
+ #:select (check-device-initrd-modules))
#:autoload (gnu build file-systems) (find-partition-by-luks-uuid)
- #:autoload (gnu build linux-modules)
- (device-module-aliases matching-modules)
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1)
@@ -154,21 +154,6 @@
#~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
"close" #$target)))
-(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."
- (let ((modules (delete-duplicates
- (append-map matching-modules
- (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)))
- (&error-location
- (location (source-properties->location location))))))))
-
(define* (check-luks-device md #:key
needed-for-boot?
(initrd-modules '())
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 91ff32ce9a..ae8780d2e1 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -30,6 +30,8 @@
#:use-module (guix records)
#:use-module (guix modules)
#:use-module (guix utils)
+ #:use-module (guix hash)
+ #:use-module (guix base32)
#:use-module ((gnu build vm)
#:select (qemu-command))
@@ -544,13 +546,13 @@ of the GNU system as described by OS."
(define (file-system->mount-tag fs)
"Return a 9p mount tag for host file system FS."
- ;; QEMU mount tags cannot contain slashes and cannot start with '_'.
- ;; Compute an identifier that corresponds to the rules.
+ ;; QEMU mount tags must be ASCII, at most 31-byte long, cannot contain
+ ;; slashes, and cannot start with '_'. Compute an identifier that
+ ;; corresponds to the rules.
(string-append "TAG"
- (string-map (match-lambda
- (#\/ #\_)
- (chr chr))
- fs)))
+ (string-drop (bytevector->base32-string
+ (sha1 (string->utf8 fs)))
+ 4)))
(define (mapping->file-system mapping)
"Return a 9p file system that realizes MAPPING."