diff options
| -rw-r--r-- | gnu/machine/ssh.scm | 3 | ||||
| -rw-r--r-- | gnu/system.scm | 23 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 3 | ||||
| -rw-r--r-- | tests/boot-parameters.scm | 23 |
4 files changed, 48 insertions, 4 deletions
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 5020bd362f..a3a12fb54b 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -482,6 +482,8 @@ an environment type of 'managed-host." (list (second boot-parameters)))) (locale -> (boot-parameters-locale (second boot-parameters))) + (store-dir -> (boot-parameters-store-directory-prefix + (second boot-parameters))) (old-entries -> (map boot-parameters->menu-entry (drop boot-parameters 2))) (bootloader -> (operating-system-bootloader @@ -492,6 +494,7 @@ an environment type of 'managed-host." bootloader)) bootloader entries #:locale locale + #:store-directory-prefix store-dir #:old-entries old-entries))) (remote-result (machine-remote-eval machine remote-exp))) (when (eqv? 'error remote-result) diff --git a/gnu/system.scm b/gnu/system.scm index a3122eaa65..ff9ab18f22 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -148,6 +148,7 @@ boot-parameters-bootloader-name boot-parameters-bootloader-menu-entries boot-parameters-store-device + boot-parameters-store-directory-prefix boot-parameters-store-mount-point boot-parameters-locale boot-parameters-kernel @@ -293,12 +294,17 @@ directly by the user." ;; understand that. The 'root-device', on the other hand, corresponds ;; exactly to the device field of the <file-system> object representing the ;; OS's root file system, so it might be a device path like "/dev/sda3". + ;; The 'store-directory-prefix' field contains #f or the store path inside + ;; the 'store-device' as it is seen by GRUB, e.g. it would contain + ;; "/storefs" if the store is located in that subvolume of a btrfs + ;; partition. (root-device boot-parameters-root-device) (bootloader-name boot-parameters-bootloader-name) (bootloader-menu-entries ;list of <menu-entry> boot-parameters-bootloader-menu-entries) (store-device boot-parameters-store-device) (store-mount-point boot-parameters-store-mount-point) + (store-directory-prefix boot-parameters-store-directory-prefix) (locale boot-parameters-locale) (kernel boot-parameters-kernel) (kernel-arguments boot-parameters-kernel-arguments) @@ -394,6 +400,17 @@ file system labels." (_ ;the old format root-device)))) + (store-directory-prefix + (match (assq 'store rest) + (('store . store-data) + (match (assq 'directory-prefix store-data) + (('directory-prefix prefix) prefix) + ;; No directory-prefix found. + (_ #f))) + (_ + ;; No store found, old format. + #f))) + (store-mount-point (match (assq 'store rest) (('store ('device _) ('mount-point mount-point) _ ...) @@ -1294,6 +1311,7 @@ such as '--root' and '--load' to <boot-parameters>." (let* ((initrd (and (not (operating-system-hurd os)) (operating-system-initrd-file os))) (store (operating-system-store-file-system os)) + (file-systems (operating-system-file-systems os)) (locale (operating-system-locale os)) (bootloader (bootloader-configuration-bootloader (operating-system-bootloader os))) @@ -1315,6 +1333,7 @@ such as '--root' and '--load' to <boot-parameters>." (bootloader-configuration-menu-entries (operating-system-bootloader os))) (locale locale) (store-device (ensure-not-/dev (file-system-device store))) + (store-directory-prefix (btrfs-store-subvolume-file-name file-systems)) (store-mount-point (file-system-mount-point store))))) (define (device->sexp device) @@ -1371,7 +1390,9 @@ being stored into the \"parameters\" file)." (device #$(device->sexp (boot-parameters-store-device params))) (mount-point #$(boot-parameters-store-mount-point - params)))) + params)) + (directory-prefix + #$(boot-parameters-store-directory-prefix params)))) #:set-load-path? #f))) (define-gexp-compiler (operating-system-compiler (os <operating-system>) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 9ed5c26483..ad998156c2 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -385,6 +385,8 @@ STORE is an open connection to the store." (params (first (profile-boot-parameters %system-profile (list number)))) (locale (boot-parameters-locale params)) + (store-directory-prefix + (boot-parameters-store-directory-prefix params)) (old-generations (delv number (reverse (generation-numbers %system-profile)))) (old-params (profile-boot-parameters @@ -398,6 +400,7 @@ STORE is an open connection to the store." ((bootloader-configuration-file-generator bootloader) bootloader-config entries #:locale locale + #:store-directory-prefix store-directory-prefix #:old-entries old-entries))) (drvs -> (list bootcfg))) (mbegin %store-monad diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm index d7e579bc89..a00b227551 100644 --- a/tests/boot-parameters.scm +++ b/tests/boot-parameters.scm @@ -46,6 +46,9 @@ (define %default-initrd (string-append %default-initrd-path "/initrd.cpio.gz")) (define %default-root-device (uuid "abcdef12-3456-7890-abcd-ef1234567890")) (define %default-store-device (uuid "01234567-89ab-cdef-0123-456789abcdef")) +(define %default-btrfs-subvolume "testfs") +(define %default-store-directory-prefix + (string-append "/" %default-btrfs-subvolume)) (define %default-store-mount-point (%store-prefix)) (define %default-multiboot-modules '()) (define %default-locale "es_ES.utf8") @@ -63,6 +66,7 @@ (multiboot-modules %default-multiboot-modules) (locale %default-locale) (store-device %default-store-device) + (store-directory-prefix %default-store-directory-prefix) (store-mount-point %default-store-mount-point))) (define %default-operating-system @@ -81,7 +85,10 @@ (file-system (device %default-store-device) (mount-point %default-store-mount-point) - (type "btrfs")) + (type "btrfs") + (options + (string-append "subvol=" + %default-btrfs-subvolume))) %base-file-systems)))) (define (quote-uuid uuid) @@ -103,6 +110,7 @@ (with-store #t) (store-device (quote-uuid %default-store-device)) + (store-directory-prefix %default-store-directory-prefix) (store-mount-point %default-store-mount-point)) (define (generate-boot-parameters) (define (sexp-or-nothing fmt val) @@ -117,10 +125,12 @@ (sexp-or-nothing " (kernel-arguments ~S)" kernel-arguments) (sexp-or-nothing " (initrd ~S)" initrd) (if with-store - (format #false " (store~a~a)" + (format #false " (store~a~a~a)" (sexp-or-nothing " (device ~S)" store-device) (sexp-or-nothing " (mount-point ~S)" - store-mount-point)) + store-mount-point) + (sexp-or-nothing " (directory-prefix ~S)" + store-directory-prefix)) "") (sexp-or-nothing " (locale ~S)" locale) (sexp-or-nothing " (bootloader-name ~a)" bootloader-name) @@ -149,6 +159,7 @@ (test-read-boot-parameters #:store-device #false) (test-read-boot-parameters #:store-device 'false) (test-read-boot-parameters #:store-mount-point #false) + (test-read-boot-parameters #:store-directory-prefix #false) (test-read-boot-parameters #:multiboot-modules #false) (test-read-boot-parameters #:locale #false) (test-read-boot-parameters #:bootloader-name #false @@ -253,4 +264,10 @@ (operating-system-boot-parameters %default-operating-system %default-root-device))) +(test-equal "from os, store-directory-prefix" + %default-store-directory-prefix + (boot-parameters-store-directory-prefix + (operating-system-boot-parameters %default-operating-system + %default-root-device))) + (test-end "boot-parameters") |