diff --git a/doc/guix.texi b/doc/guix.texi index 3fd2a139685..0c002113078 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18783,6 +18783,27 @@ this option can have a negative security impact because it can make file system level operations visible on the physical device. For more information, refer to the description of the @code{--allow-discards} option in the @code{cryptsetup-open(8)} man page. + +@item #:extra-options +List of additional command-line options for the @code{cryptsetup open} +command. See the @code{cryptsetup-open(8)} man page for a list of +supported options. + +For example, here is how you could specify the +@option{--perf-no_read_workqueue} and @option{--perf-no_write_workqueue} +options, along with @option{--allow-discards}: + +@lisp +(mapped-device + (source "/dev/sdb1") + (target "data") + (type luks-device-mapping) + (arguments '(#:allow-discards? #t + #:extra-options + ("--perf-no_read_workqueue" + "--perf-no_write_workqueue"))))) +@end lisp + @end table @end defvar diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index b0a6beef280..d568bddc4ff 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -43,6 +43,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) + #:use-module (ice-9 optargs) #:use-module (ice-9 format) #:export (%mapped-device mapped-device @@ -200,10 +201,12 @@ option of @command{guix system}.\n") ;;; Common device mappings. ;;; -(define* (open-luks-device source targets #:key key-file allow-discards?) +(define* (open-luks-device source targets + #:key key-file allow-discards? (extra-options '())) "Return a gexp that maps SOURCE to TARGET as a LUKS device, using 'cryptsetup'. When ALLOW-DISCARDS? is true, the use of discard (TRIM) -requests is allowed for the underlying device." +requests is allowed for the underlying device. EXTRA-OPTIONS is a list of +additional options to be passed to the 'cryptsetup open' command." (with-imported-modules (source-module-closure '((gnu build file-systems) (guix build utils))) ;; For mkdir-p @@ -244,10 +247,13 @@ requests is allowed for the underlying device." (let ((cryptsetup #$(file-append cryptsetup-static "/sbin/cryptsetup")) (cryptsetup-flags (cons* - "open" "--type" "luks" partition #$target - (if #$allow-discards? - '("--allow-discards") - '())))) + "open" "--type" "luks" + (append + (if #$allow-discards? + '("--allow-discards") + '()) + '#$extra-options + (list partition #$target))))) ;; We want to fallback to the password unlock if the keyfile ;; fails. (or (and keyfile @@ -271,6 +277,17 @@ requests is allowed for the underlying device." "Ensure the source of MD is valid." (let ((source (mapped-device-source md)) (location (mapped-device-location md))) + (let-keywords (mapped-device-arguments md) #t + ((extra-options '()) + key-file allow-discards) + (unless (list? extra-options) + (raise (make-compound-condition + (formatted-message (G_ "invalid value ~s for #:extra-options \ +argument of `open-luks-device'") + extra-options) + (condition + (&error-location + (location (source-properties->location location)))))))) (or (not (zero? (getuid))) (if (uuid? source) (match (find-partition-by-luks-uuid (uuid-bytevector source)) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index b26dc890a44..cb845c64cc2 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -67,6 +67,7 @@ %test-separate-home-os %test-raid-root-os %test-encrypted-root-os + %test-encrypted-root-extra-options-os %test-encrypted-home-os %test-encrypted-home-os-key-file %test-encrypted-root-not-boot-os @@ -842,6 +843,73 @@ build (current-guix) and then store a couple of full system images.") (run-basic-test %encrypted-root-os command "encrypted-root-os" #:initialization enter-luks-passphrase))))) + +;;; +;;; LUKS-encrypted root with extra options: --allow-discards, +;;; --perf-no_read_workqueue and --perf-no_write_workqueue +;;; + +;; Except for the 'mapped-devices' field, this is exactly the same as +;; %encrypted-root-os. +(define-os-with-source (%encrypted-root-extra-options-os + %encrypted-root-extra-options-os-source) + ;; The OS we want to install. + (use-modules (gnu) (gnu tests) (srfi srfi-1)) + + (operating-system + (host-name "liberigilo") + (timezone "Europe/Paris") + (locale "en_US.UTF-8") + + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (targets '("/dev/vdb")))) + + ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt + ;; detection logic in 'enter-luks-passphrase'. + + (mapped-devices (list (mapped-device + (source (uuid "12345678-1234-1234-1234-123456789abc")) + (target "the-root-device") + (type luks-device-mapping) + (arguments '(#:allow-discards? #t + #:extra-options + ("--perf-no_read_workqueue" + "--perf-no_write_workqueue")))))) + (file-systems (cons (file-system + (device "/dev/mapper/the-root-device") + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (users (cons (user-account + (name "charlie") + (group "users") + (supplementary-groups '("wheel" "audio" "video"))) + %base-user-accounts)) + (services (cons (service marionette-service-type + (marionette-configuration + (imported-modules '((gnu services herd) + (guix combinators))))) + %base-services)))) + +(define %test-encrypted-root-extra-options-os + (system-test + (name "encrypted-root-extra-options-os") + (description + "Test basic functionality of an OS installed like one would do by hand, +with an LUKS-encrypted root partition opened with extra options +(--allow-discards, --perf-no_read_workqueue and --perf-no_write_workqueue). +This test is expensive in terms of CPU and storage usage since we need to +build (current-guix) and then store a couple of full system images.") + (value + (mlet* %store-monad ((images (run-install %encrypted-root-extra-options-os + %encrypted-root-extra-options-os-source + #:script + %encrypted-root-installation-script)) + (command (qemu-command* images))) + (run-basic-test %encrypted-root-os command "encrypted-root-extra-options-os" + #:initialization enter-luks-passphrase))))) + ;;; ;;; Separate /home on LVM