From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:41068) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j4V01-0005eJ-7y for guix-patches@gnu.org; Wed, 19 Feb 2020 14:27:15 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1j4Uzv-0006bE-2K for guix-patches@gnu.org; Wed, 19 Feb 2020 14:27:09 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:37433) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1j4Uzu-0006ax-P3 for guix-patches@gnu.org; Wed, 19 Feb 2020 14:27:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1j4Uzu-0001UB-JC for guix-patches@gnu.org; Wed, 19 Feb 2020 14:27:02 -0500 Subject: [bug#37305] Allow booting from a Btrfs subvolume [review part 2] References: <87sgpby4p9.fsf@gmail.com> In-Reply-To: <87sgpby4p9.fsf@gmail.com> Resent-Message-ID: From: Maxim Cournoyer Date: Tue, 18 Feb 2020 21:52:24 -0500 (15 hours, 38 minutes, 5 seconds ago) Message-ID: <875zg2xtsb.fsf@gmail.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 37305@debbugs.gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Ludovic, Here comes part 2! Ludovic Court=C3=A8s writes: >> From 6cf2ece21683e98544f8f46675aef58d5a7231fd Mon Sep 17 00:00:00 2001 >> From: Maxim Cournoyer >> Date: Sun, 14 Jul 2019 20:50:23 +0900 >> Subject: [PATCH 8/9] bootloader: grub: Allow booting from a Btrfs subvol= ume. >> >> * gnu/bootloader/grub.scm (grub-configuration-file) [btrfs-subvolume-pat= h]: >> New parameter. When it is defined, prepend its value to the kernel and >> initrd file paths. >> * gnu/bootloader/depthcharge.scm (depthcharge-configuration-file): Adapt. >> * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Likewise. >> * gnu/system/file-systems.scm (btrfs-subvolume?) >> (btrfs-store-subvolume-path): New procedures. >> * gnu/system.scm (operating-system-bootcfg): Specify the Btrfs subvolume= path >> of the GNU store to the `operating-system-bootcfg' procedure, using the = new >> BTRFS-SUBVOLUME-PATH argument. >> * doc/guix.texi (File Systems): Add a Btrfs subsection to document the u= se of >> subvolumes. Document the new `properties' field of the `' >> record. >> * gnu/tests/install.scm: Add test "btrfs-root-on-subvolume-os". > > Neat! > >> (define* (grub-configuration-file config entries >> #:key >> (system (%current-system)) >> - (old-entries '())) >> + (old-entries '()) >> + btrfs-subvolume-path) >> "Return the GRUB configuration file corresponding to CONFIG, a >> object, and where the store is available at >> STORE-FS, a object. OLD-ENTRIES is taken to be a list of= menu >> -entries corresponding to old generations of the system." >> +entries corresponding to old generations of the system. BTRFS-SUBVOLUM= E-PATH >> +may be used to specify on which subvolume a Btrfs root file system resi= des." > > (Nitpick: s/path/file name/ :-)) I stand corrected! From '(Standards)GNU Manuals': Please do not use the term "pathname" that is used in Unix documentation; use "file name" (two words) instead. We use the term "path" only for search paths, which are lists of directory names. > It=E2=80=99s a bit problematic that (1) GRUB needs explicit Btrfs support= , and > (2) other bootloaders will silently ignore the option, due to > #:allow-other-keys. > > I don=E2=80=99t have a better idea, but it=E2=80=99d be great if Btrfs su= pport could be > made bootloader-independent, and if it could be somewhat > not-too-btrfs-specific, if that is possible at all. > > Thoughts? I have no idea how Btrfs subvolumes are handled (if at all) on U-Boot or other bootloaders than GRUB. All I know is that for GRUB they need to handle subvolumes in a special manner in their own grub-mkconfig tool (which we bypass). Also, I'm afraid subvolumes are very Btrfs specific :-). It doesn't exist in traditional file systems like EXT4. I think ZFS must have something similar, though. >> + (properties file-system-properties ; list of name-value = pairs >> + (default '())) >> (location file-system-location >> (default (current-source-location)) >> (innate))) >> @@ -582,4 +589,48 @@ system has the given TYPE." >> (or (string-prefix-ci? "x-" option-name) >> (member option-name %file-system-independent-mount-options)))) >> >> +(define (btrfs-subvolume? fs) >> + "Predicate to check if FS, a file-system object, is a Btrfs subvolume= ." >> + (and-let* ((btrfs-file-system? (string=3D "btrfs" (file-system-type f= s))) >> + (option-keys (map (match-lambda >> + ((key . value) key) >> + (key key)) >> + (file-system-options fs)))) >> + (find (cut string-prefix? "subvol" <>) option-keys))) > > I wonder if we can avoid special support in the API for > Btrfs. > >> + (error "The store is on a Btrfs subvolume, but the \ >> +subvolume name is unknown. >> +Hint: Define the \"btrfs-subvolume-path\" file system property or >> +use the \"subvol\" Btrfs file system option.")))) > Rather use =E2=80=98raise=E2=80=99 with =E2=80=98&message=E2=80=99 and = =E2=80=98&fix-hint=E2=80=99 conditions. I tried this, but importing (guix utils) to acces &fix-hint caused the init RAM disk to fail mysteriously: --8<---------------cut here---------------start------------->8--- [ 0.614503] Run /init as init process GC Warning: pthread_getattr_np or pthread_attr_getstack failed for main thr= ead GC Warning: Couldn't read /proc/stat Backtrace: In ice-9/boot-9.scm: 222:29 19 (map1 (((ice-9 match)) ((rnrs bytevectors)) ((srfi=20 222:29 18 (map1 (((rnrs bytevectors)) ((srfi srfi-1)) ((srfi=20 222:29 17 (map1 (((srfi srfi-1)) ((srfi srfi-2)) ((srfi #)) (#)=20 222:29 16 (map1 (((srfi srfi-2)) ((srfi srfi-9)) ((srfi #)) (#)=20 222:29 15 (map1 (((srfi srfi-9)) ((srfi srfi-26)) ((srfi #)) (#)=20 222:29 14 (map1 (((srfi srfi-26)) ((srfi srfi-35)) ((srfi # #))=20 222:29 13 (map1 (((srfi srfi-35)) ((srfi srfi-9 gnu)) ((guix=20 ))[ 0.657578] random: fast init done 222:29 12 (map1 (((srfi srfi-9 gnu)) ((guix records)) ((guix=20 222:29 11 (map1 (((guix records)) ((guix utils)) ((gnu system=20 )))) 222:17 10 (map1 (((guix utils)) ((gnu system uuid)))) 2800:17 9 (resolve-interface (guix utils) #:select _ #:hide _ # _=20 In ice-9/threads.scm: 390:8 8 (_ _) In ice-9/boot-9.scm: 2726:13 7 (_) In ice-9/threads.scm: 390:8 6 (_ _) In ice-9/boot-9.scm: 2994:20 5 (_) 2312:4 4 (save-module-excursion #) ERROR: In procedure dynamic-func: In procedure dynamic-pointer: Symbol not found: strverscmp [ 0.697002] Kernel panic - not syncing: Attempted to kill init! exitcode= =3D0x00000100 [ 0.697894] CPU: 0 PID: 1 Comm: init Not tainted 5.4.18-gnu #1 [ 0.698592] Hardware name: QEMU Standard PC (i440FX + PIIX, 1996), BIOS = rel-1.12.0-59-gc9ba5276e321-prebuilt.qemu.org 04/01/2014 [ 0.699938] Call Trace: [ 0.700240] dump_stack+0x6d/0x8d [ 0.700640] panic+0x10b/0x2f4 [ 0.701010] do_exit+0x7e2/0xb80 [ 0.701398] ? wake_up_state+0x1f/0x30 [ 0.701847] ? signal_wake_up_state+0x24/0x40 [ 0.702374] do_group_exit+0x44/0xa0 [ 0.702805] __x64_sys_exit_group+0x1c/0x20 [ 0.703306] do_syscall_64+0x5a/0x190 [ 0.703748] entry_SYSCALL_64_after_hwframe+0x44/0xa9 [ 0.704347] RIP: 0033:0x5df9c6 [ 0.704716] Code: 00 00 00 be 3c 00 00 00 eb 19 66 2e 0f 1f 84 00 00 00 = 00 00 89 d7 89 f0 0f 05 48 3d 00 f0 ff ff 77 22 f4 89 d7 44 89 c0 0f 05 <48= > 3d 00 f0 ff ff 76 e2 f7 d8 64 41 89 01 eb da 66 2e 0f 1f 84 00 [ 0.706919] RSP: 002b:00007ffd9fa65228 EFLAGS: 00000246 ORIG_RAX: 000000= 00000000e7 [ 0.707808] RAX: ffffffffffffffda RBX: 00000000007c51f0 RCX: 00000000005= df9c6 [ 0.708643] RDX: 0000000000000001 RSI: 000000000000003c RDI: 00000000000= 00001 [ 0.709482] RBP: 0000000000000001 R08: 00000000000000e7 R09: fffffffffff= fffb0 [ 0.710328] R10: 0000000000436340 R11: 0000000000000246 R12: 00000000007= c51f0 [ 0.711166] R13: 0000000000000001 R14: 0000000000000000 R15: 00000000000= 00003 [ 0.712026] Kernel Offset: 0x13000000 from 0xffffffff81000000 (relocatio= n range: 0xffffffff80000000-0xffffffffbfffffff) [ 0.713288] Rebooting in 1 seconds.. file-size: /gnu/store/zfi66vny0h10d180xajgm4pq2vnvmc2z-nss-certs-3.49.1/etc= /ssl/certs/NetLock_Arany_=3DClass_Gold=3D_F??tan??s??tv??ny:2.6.73.65.44.22= 8.0.16.pem: No such file or directory file-size: /gnu/store/04xpkgf9zlhcngyr6gnhl4rb8g6v6i1i-profile/etc/ssl/cert= s/NetLock_Arany_=3DClass_Gold=3D_F??tan??s??tv??ny:2.6.73.65.44.228.0.16.pe= m: No such file or directory --8<---------------cut here---------------end--------------->8--- The exception I had refactored to use with &fix-hint looked like: --8<---------------cut here---------------start------------->8--- (raise (condition (&message (message "The store is on a Btrfs subvolume, \ but the subvolume name is unknown.")) (&fix-hint (hint "Define the \"btrfs-subvolume-file-name\" \ file system property or use the \"subvol\" Btrfs file system option.")))) --8<---------------cut here---------------end--------------->8--- So, I ended up using just a &message condition with the hint embedded in it. The attached patch (v3) incorporate the agreed changes so far. The btrfs-root-on-subvolume-os test still passes. Thank you for your patience, Maxim --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-gnu-tests-Reduce-the-time-required-to-run-the-system.patch Content-Transfer-Encoding: quoted-printable >From 3640bea548826e1c1ec9b766da1fdfe4791d7452 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 17 Nov 2019 06:01:00 +0900 Subject: [PATCH 1/8] gnu: tests: Reduce the time required to run the system tests. When setting the GUIX_DEV_HACKS environment variable, the Guix package used inside the instrumented VMs recycles the binaries already found in the Guix checkout of the developer instead of rebuilding Guix from scratch. This brings the time required for this component from 20+ minutes down to 2-3 minutes on an X200 machine. * gnu/packages/package-management.scm (current-guix/pre-built): New procedu= re. * build-aux/run-system-tests.scm (tests-for-channel-instance): Use it, when GUIX_DEV_HACKS is defined. --- build-aux/run-system-tests.scm | 11 ++++- gnu/packages/package-management.scm | 66 +++++++++++++++++++++++++++++ 2 files changed, 76 insertions(+), 1 deletion(-) diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm index b0cb3bd2bf..04b6fa29c3 100644 --- a/build-aux/run-system-tests.scm +++ b/build-aux/run-system-tests.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2016, 2018, 2019 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -58,8 +59,16 @@ instance." ;; of tests to run in the usual way: ;; ;; make check-system TESTS=3Dinstalled-os + + ;; When the GUIX_DEV_HACKS environment variable is defined, override the + ;; package returned by `current-guix' with a flavor that saves recompili= ng + ;; Guix from scratch and reuse the developer's checkout binaries. The + ;; override "builds" about 20 times faster than the regular `current-gui= x' + ;; package, which can help speed iterative development. (parameterize ((current-guix-package - (channel-instance->package instance))) + (if (getenv "GUIX_DEV_HACKS") + (current-guix/pre-built) + (channel-instance->package instance)))) (match (getenv "TESTS") (#f (all-system-tests)) diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-man= agement.scm index 422d4f1959..bd2ed85189 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -468,6 +468,72 @@ out) and returning a package that uses that as its 'so= urce'." #:recursive? #t #:select? (force select?)))))))) =20 +(define-public (current-guix/pre-built) + "Similar to `current-guix', but with a modified build procedure that +reuses the existing byte compiled artifacts to save recompilation time." + + (let* ( ;; The `current-source-directory' macro doesn't work from the RE= PL. + ;; For testing, you can replace it with a static string pointing = to + ;; your Guix checkout directory. + (repository-root (delay (canonicalize-path + (string-append (current-source-directory) + "/../..")))) + (select? (lambda (file stat) + (match (basename file) + ((or ".git" + "configure" "autom4te.cache" + "config.log" "config.status" + "stamp-1" "stamp-2" "stamp-3" "stamp-4" "stamp-= 5" + "stamp-h1" "stamp-vti" + "Makefile" "Makefile.in" ".libs" + ".deps" ".dirstamp" + "test-tmp" + ) #f) + (_ #t))))) + (package + (inherit guix) + (version (string-append (package-version guix) "+")) + (source (local-file (force repository-root) "guix-current" + #:recursive? #t + #:select? select?)) + (arguments + (substitute-keyword-arguments (package-arguments guix) + ((#:phases phases) + `(modify-phases ,phases + ;; XXX: References to tools such as 'mkdir' and 'install' are + ;; captured in Makefile.in when 'autoconf' is run. It'd be n= icer + ;; to find those at configuration time. + (delete 'copy-bootstrap-guile) + (delete 'check) + (delete 'disable-failing-tests) + (delete 'strip) ;can't strip .go files anyway + (replace 'build + (lambda _ + ;; Set the write permission bit on some files that need t= o be + ;; touched. + (chmod "nix" #o777) + (for-each (lambda (f) + (chmod f #o666)) + (cons* "guix-daemon" + (find-files "." ".*\\.(a|o)$"))) + + ;; The following prevent 'make install' from rebuilding t= he + ;; daemon and the documentation. + (invoke "make" "--touch" "info" + ;; TODO: Currently we must rebuild the daemon as = it + ;; was linked against external dependencies that + ;; depend on the provenance of the profile (or + ;; environment) that was used to build it. + + ;; If we could query the provenance of any profil= e, + ;; we could make this package inherit from the gu= ix + ;; inferior that was used to provide such + ;; dependencies. The most reliable way would + ;; probably be to record that provenance at build + ;; time (as a make target). + ;"guix-daemon" + )))))))))) + ;;; ;;; Other tools. --=20 2.25.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-linux-boot-Ensure-volatile-root-is-mounted-read-only.patch >From c6e00c0eb8b2ed0c758e9c1be28c6e93f4795a64 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 11 Feb 2020 12:57:29 -0500 Subject: [PATCH 2/8] linux-boot: Ensure volatile root is mounted read-only. * gnu/build/linux-boot.scm (mount-root-file-system): Ensure MS_RDONLY is present among the root file system flags when VOLATILE-ROOT? is #t. --- gnu/build/linux-boot.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index 3d40a7d05d..4fb711b8f2 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -362,12 +362,12 @@ the last argument of `mknod'." "Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is true, mount ROOT read-only and make it an overlay with a writable tmpfs using the kernel built-in overlayfs. FLAGS and OPTIONS indicates the options to use -to mount ROOT." +to mount ROOT, and behave the same as for the `mount' procedure." (if volatile-root? (begin (mkdir-p "/real-root") - (mount root "/real-root" type MS_RDONLY options) + (mount root "/real-root" type (logior MS_RDONLY flags) options) (mkdir-p "/rw-root") (mount "none" "/rw-root" "tmpfs") -- 2.25.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-file-systems-Add-a-file-system-device-string-procedu.patch >From c367fc7efeb8ff15c22a98f32098bbcdbf1457b6 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 11 Feb 2020 23:56:45 -0500 Subject: [PATCH 3/8] file-systems: Add a 'file-system-device->string' procedure. * gnu/system/file-systems.scm (file-system-device->string): New procedure. * gnu/system.scm (bootable-kernel-arguments): Use it. * gnu/system/vm.scm (operating-system-uuid): Likewise. * guix/scripts/system.scm (display-system-generation): Likewise. --- gnu/system.scm | 15 +++++---------- gnu/system/file-systems.scm | 15 +++++++++++++++ gnu/system/vm.scm | 8 +------- guix/scripts/system.scm | 7 +------ 4 files changed, 22 insertions(+), 23 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index 01baa248a2..2e6d03272d 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -142,16 +142,11 @@ (define (bootable-kernel-arguments system root-device) "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE." (list (string-append "--root=" - (cond ((uuid? root-device) - - ;; Note: Always use the DCE format because that's - ;; what (gnu build linux-boot) expects for the - ;; '--root' kernel command-line option. - (uuid->string (uuid-bytevector root-device) - 'dce)) - ((file-system-label? root-device) - (file-system-label->string root-device)) - (else root-device))) + ;; Note: Always use the DCE format because that's what + ;; (gnu build linux-boot) expects for the '--root' + ;; kernel command-line option. + (file-system-device->string root-device + #:uuid-type 'dce)) #~(string-append "--system=" #$system) #~(string-append "--load=" #$system "/boot"))) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index d47a514b66..3b599efa8e 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -30,6 +30,7 @@ #:export (file-system file-system? file-system-device + file-system-device->string file-system-title ;deprecated file-system-mount-point file-system-type @@ -235,6 +236,20 @@ where both FILE1 and FILE2 are absolute file name. For example: (() #f))))))) +(define* (file-system-device->string device #:key uuid-type) + "Return the string representations of the DEVICE field of a +record. When the device is a UUID, its representation is chosen depending on +UUID-TYPE, a symbol such as 'dce or 'iso9660." + (match device + ((? file-system-label?) + (file-system-label->string device)) + ((? uuid?) + (if uuid-type + (uuid->string (uuid-bytevector device) uuid-type) + (uuid->string device))) + ((? string?) + device))) + (define (file-system-needed-for-boot? fs) "Return true if FS has the 'needed-for-boot?' flag set, or if it holds the store--e.g., if FS is the root file system." diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 81b2e06ba2..03a511cdde 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -609,13 +609,7 @@ TYPE (one of 'iso9660 or 'dce). Return a UUID object." (let ((device (file-system-device fs))) (list (file-system-mount-point fs) (file-system-type fs) - (cond ((file-system-label? device) - (file-system-label->string device)) - ((uuid? device) - (uuid->string device)) - ((string? device) - device) - (else #f)) + (file-system-device->string device) (file-system-options fs)))) (if (eq? type 'iso9660) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index e69a3b6c97..b0386a1392 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -517,12 +517,7 @@ list of services." (cond ((uuid? root-device) 0) ((file-system-label? root-device) 1) (else 2)) - (cond ((uuid? root-device) - (uuid->string root-device)) - ((file-system-label? root-device) - (file-system-label->string root-device)) - (else - root-device))) + (file-system-device->string root-device)) (format #t (G_ " kernel: ~a~%") kernel) -- 2.25.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-linux-boot-Refactor-boot-system.patch >From 7593b5dfeb180acf51dd7f586f31b1c8c671f1fa Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 11 Feb 2020 14:00:06 -0500 Subject: [PATCH 4/8] linux-boot: Refactor boot-system. The --root option can now be omitted, and inferred from the root file system declaration instead. * gnu/build/linux-boot.scm (boot-system): Remove nested definitions for root-fs-type, root-fs-flags and root-fs-options, and bind those inside the let* instead. Make "--root" take precedence over the device field string representation of the root file system. * doc/guix.texi (Initial RAM Disk): Document that "--root" can be left unspecified. --- doc/guix.texi | 7 +++-- gnu/build/linux-boot.scm | 66 +++++++++++++++++++++------------------- 2 files changed, 38 insertions(+), 35 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 42d7cfa2e8..85cfabc2f3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -25917,9 +25917,10 @@ service activation programs and then spawns the GNU@tie{}Shepherd, the initialization system. @item --root=@var{root} -Mount @var{root} as the root file system. @var{root} can be a -device name like @code{/dev/sda1}, a file system label, or a file system -UUID. +Mount @var{root} as the root file system. @var{root} can be a device +name like @code{/dev/sda1}, a file system label, or a file system UUID. +When unspecified, the device name from the root file system of the +operating system declaration is used. @item --system=@var{system} Have @file{/run/booted-system} and @file{/run/current-system} point to diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index 4fb711b8f2..c3229fa292 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -467,25 +467,13 @@ upon error." (define (root-mount-point? fs) (string=? (file-system-mount-point fs) "/")) - (define root-fs-type - (or (any (lambda (fs) - (and (root-mount-point? fs) - (file-system-type fs))) - mounts) - "ext4")) - - (define root-fs-flags - (mount-flags->bit-mask (or (any (lambda (fs) - (and (root-mount-point? fs) - (file-system-flags fs))) - mounts) - '()))) - - (define root-fs-options - (any (lambda (fs) - (and (root-mount-point? fs) - (file-system-options fs))) - mounts)) + (define (device-string->file-system-device device-string) + ;; The "--root=SPEC" kernel command-line option always provides a + ;; string, but the string can represent a device, a UUID, or a + ;; label. So check for all three. + (cond ((string-prefix? "/" device-string) device-string) + ((uuid device-string) => identity) + (else (file-system-label device-string)))) (display "Welcome, this is GNU's early boot Guile.\n") (display "Use '--repl' for an initrd REPL.\n\n") @@ -495,7 +483,27 @@ upon error." (mount-essential-file-systems) (let* ((args (linux-command-line)) (to-load (find-long-option "--load" args)) - (root (find-long-option "--root" args))) + (root-fs (find root-mount-point? mounts)) + (root-fs-type (or (and=> root-fs file-system-type) + "ext4")) + (root-fs-device (and=> root-fs file-system-device)) + (root-fs-flags (mount-flags->bit-mask + (or (and=> root-fs file-system-flags) + '()))) + (root-fs-options (if root-fs + (file-system-options root-fs) + '())) + ;; --root takes precedence over the 'device' field of the root + ;; record. + ;; TODO: Add options for the root file system type and the root + ;; file system flags as well. + (root-device (or (and=> (find-long-option "--root" args) + device-string->file-system-device) + root-fs-device)) + (root-options (if (null? root-fs-options) + #f + (file-system-options->string + root-fs-options)))) (when (member "--repl" args) (start-repl)) @@ -530,18 +538,12 @@ upon error." (setenv "EXT2FS_NO_MTAB_OK" "1") - (if root - ;; The "--root=SPEC" kernel command-line option always provides a - ;; string, but the string can represent a device, a UUID, or a - ;; label. So check for all three. - (let ((root (cond ((string-prefix? "/" root) root) - ((uuid root) => identity) - (else (file-system-label root))))) - (mount-root-file-system (canonicalize-device-spec root) - root-fs-type - #:volatile-root? volatile-root? - #:flags root-fs-flags - #:options root-fs-options)) + (if root-device + (mount-root-file-system (canonicalize-device-spec root-device) + root-fs-type + #:volatile-root? volatile-root? + #:flags root-fs-flags + #:options root-options) (mount "none" "/root" "tmpfs")) ;; Mount the specified file systems. -- 2.25.0 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0005-file-systems-Represent-the-file-system-options-as-an.patch Content-Transfer-Encoding: quoted-printable >From a9b65ec0b4aa80c99c544aad41ec19ab64b295b0 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Wed, 25 Sep 2019 22:43:41 +0900 Subject: [PATCH 5/8] file-systems: Represent the file system options as an alist. This allows accessing the parameter values easily, without having to parse a string. * gnu/system/file-systems.scm (): Update the default value of = the OPTIONS field, doc. (%file-system-options): Field accessor renamed from `file-system-options'. (file-system-options, file-system-options->string): New procedures. * gnu/build/file-systems.scm (mount-file-system): Adapt. * gnu/services/base.scm (file-system->fstab-entry): Likewise. * tests/file-systems.scm: New tests. * doc/guix.texi (File Systems): Document the modified default value of the 'file-system-options' field. --- doc/guix.texi | 11 ++++++----- gnu/build/file-systems.scm | 15 +++++++++------ gnu/services/base.scm | 35 +++++++++++++++++++---------------- gnu/system/file-systems.scm | 37 +++++++++++++++++++++++++++++++++++-- tests/file-systems.scm | 24 ++++++++++++++++++++++++ 5 files changed, 93 insertions(+), 29 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 85cfabc2f3..5d526b1aee 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11405,11 +11405,12 @@ update time on the in-memory version of the file = inode), and @xref{Mount-Unmount-Remount,,, libc, The GNU C Library Reference Manual}, for more information on these flags. =20 -@item @code{options} (default: @code{#f}) -This is either @code{#f}, or a string denoting mount options passed to the -file system driver. @xref{Mount-Unmount-Remount,,, libc, The GNU C Library -Reference Manual}, for details and run @command{man 8 mount} for options f= or -various file systems. +@item @code{options} (default: @code{'()}) +A list of parameters and/or of pairs of parameter name and values, as +strings. Those represent the mount options that are passed to the file +system driver. @xref{Mount-Unmount-Remount,,, libc, The GNU C Library +Reference Manual}, for details and run @command{man 8 mount} for options +for various file systems. =20 @item @code{mount?} (default: @code{#t}) This value indicates whether to automatically mount the file system when diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index ee6375515f..cfa3898f83 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -662,12 +662,15 @@ corresponds to the symbols listed in FLAGS." (if options (string-append "," options) ""))))) - (let ((type (file-system-type fs)) - (options (file-system-options fs)) - (source (canonicalize-device-spec (file-system-device fs))) - (mount-point (string-append root "/" - (file-system-mount-point fs))) - (flags (mount-flags->bit-mask (file-system-flags fs)))) + (let* ((type (file-system-type fs)) + (fs-options (file-system-options fs)) + (options (if (null? fs-options) + #f + (file-system-options->string fs-options))) + (source (canonicalize-device-spec (file-system-device fs))) + (mount-point (string-append root "/" + (file-system-mount-point fs))) + (flags (mount-flags->bit-mask (file-system-flags fs)))) (when (file-system-check? fs) (check-file-system source type)) =20 diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 0c154d1c4e..6104b47870 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -313,22 +313,25 @@ seconds after @code{SIGTERM} has been sent are termin= ated with =20 (define (file-system->fstab-entry file-system) "Return a @file{/etc/fstab} entry for @var{file-system}." - (string-append (match (file-system-device file-system) - ((? file-system-label? label) - (string-append "LABEL=3D" - (file-system-label->string label))) - ((? uuid? uuid) - (string-append "UUID=3D" (uuid->string uuid))) - ((? string? device) - device)) - "\t" - (file-system-mount-point file-system) "\t" - (file-system-type file-system) "\t" - (or (file-system-options file-system) "defaults") "\t" - - ;; XXX: Omit the 'fs_freq' and 'fs_passno' fields because= we - ;; don't have anything sensible to put in there. - )) + (let ((options (file-system-options file-system))) + (string-append (match (file-system-device file-system) + ((? file-system-label? label) + (string-append "LABEL=3D" + (file-system-label->string label))) + ((? uuid? uuid) + (string-append "UUID=3D" (uuid->string uuid))) + ((? string? device) + device)) + "\t" + (file-system-mount-point file-system) "\t" + (file-system-type file-system) "\t" + (if (null? options) + "defaults" + (file-system-options->string options)) "\t" + + ;; XXX: Omit the 'fs_freq' and 'fs_passno' fields becau= se we + ;; don't have anything sensible to put in there. + ))) =20 (define (file-systems->fstab file-systems) "Return a @file{/etc} entry for an @file{fstab} describing diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 3b599efa8e..c205feae70 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Cour= t=C3=A8s +;;; Copyright =C2=A9 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,6 +38,7 @@ file-system-needed-for-boot? file-system-flags file-system-options + file-system-options->string file-system-mount? file-system-check? file-system-create-mount-point? @@ -97,8 +99,8 @@ (type file-system-type) ; string (flags file-system-flags ; list of symbols (default '())) - (options file-system-options ; string or #f - (default #f)) + (options %file-system-options ; list of strings and/or + (default '())) ; pair of strings (mount? file-system-mount? ; Boolean (default #t)) (needed-for-boot? %file-system-needed-for-boot? ; Boolean @@ -250,6 +252,37 @@ UUID-TYPE, a symbol such as 'dce or 'iso9660." ((? string?) device))) =20 +(define (file-system-options fs) + "Return the options of a record, as a list of options or +option/value pairs." + + ;; Support the deprecated options format (a string). + (define (string->options str) + (let ((options (string-split str #\,))) + (map (lambda (param) + (let ((=3Dindex (string-index param #\=3D))) + (if =3Dindex + (cons (string-take param =3Dindex) + (string-drop param (1+ =3Dindex))) + param))) + options))) + + (let ((fs-options (%file-system-options fs))) + (if (string? fs-options) + (string->options fs-options) + fs-options))) + +(define (file-system-options->string options) + "Return the string representation of the OPTIONS field of a +record" + (string-join (map (match-lambda + ((key . value) + (string-append key "=3D" value)) + (key + key)) + options) + ",")) + (define (file-system-needed-for-boot? fs) "Return true if FS has the 'needed-for-boot?' flag set, or if it holds t= he store--e.g., if FS is the root file system." diff --git a/tests/file-systems.scm b/tests/file-systems.scm index 4c28d0ebc5..b9f4f50aad 100644 --- a/tests/file-systems.scm +++ b/tests/file-systems.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2015, 2017 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -64,4 +65,27 @@ (_ #f)) (source-module-closure '((gnu system file-systems))))) =20 +(define %fs-with-deprecated-options-string + (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/home") + (type "btrfs") + (options "autodefrag,subvol=3Dhome,compress=3Dlzo"))) + +(define %fs + (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/root") + (type "btrfs") + (options '("autodefrag" ("subvol" . "root") ("compress" . "lzo"))))) + +(test-equal " options given as a string (deprecated)" + '("autodefrag" ("subvol" . "home") ("compress" . "lzo")) + (file-system-options %fs-with-deprecated-options-string)) + +(test-equal " options conversion to string" + "autodefrag,subvol=3Droot,compress=3Dlzo" + (file-system-options->string + (file-system-options %fs))) + (test-end) --=20 2.25.0 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0006-linux-boot-Honor-the-root-options-kernel-argument.patch Content-Transfer-Encoding: quoted-printable >From 9e988968566f004f887080b02712043520d9327e Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 11 Feb 2020 14:14:36 -0500 Subject: [PATCH 6/8] linux-boot: Honor the "--root-options" kernel argument. * gnu/build/linux-boot.scm (boot-system): Parse the "--root-options" kernel argument, and use it when calling `mount-root-file-system'. Update doc. * doc/guix.texi (Initial RAM Disk): Document the use of the "--root-options" argument. --- doc/guix.texi | 10 ++++++++++ gnu/build/linux-boot.scm | 16 +++++++++++----- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 5d526b1aee..d6bfbd7b55 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -25935,6 +25935,16 @@ Instruct the initial RAM disk as well as the @comm= and{modprobe} command must be a comma-separated list of module names---e.g., @code{usbkbd,9pnet}. =20 +@item --root-options=3D@var{options}@dots{} +@cindex mount options for the root file system, passed to initrd +@cindex rootflags, initrd +@cindex root-options, initrd +This argument allows passing one or multiple file system specific mount +options used by the initrd to mount the root file system. @var{options} +must be a comma-separated list of option names or option-value pairs. +When unspecified, the value of the options field of the root file system +of the operating system declaration is used. + @item --repl Start a read-eval-print loop (REPL) from the initial RAM disk before it tries to load kernel modules and to mount the root file system. Our diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index c3229fa292..063daa4ca4 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -2,6 +2,7 @@ ;;; Copyright =C2=A9 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Cour= t=C3=A8s ;;; Copyright =C2=A9 2017 Mathieu Othacehe ;;; Copyright =C2=A9 2019 Guillaume Le Vaillant +;;; Copyright =C2=A9 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -452,7 +453,8 @@ LINUX-MODULE-DIRECTORY, then installing KEYMAP-FILE wit= h 'loadkeys' (if KEYMAP-FILE is true), then setting up QEMU guest networking if QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file syste= ms specified in MOUNTS, and finally booting into the new root if any. The in= itrd -supports kernel command-line options '--load', '--root', and '--repl'. +supports kernel command-line options '--load', '--root', '--root-options' = and +'--repl'. =20 Mount the root file system, specified by the '--root' command-line argumen= t, if any. @@ -493,6 +495,7 @@ upon error." (root-fs-options (if root-fs (file-system-options root-fs) '())) + ;; --root takes precedence over the 'device' field of the root ;; record. ;; TODO: Add options for the root file system type and the ro= ot @@ -500,10 +503,13 @@ upon error." (root-device (or (and=3D> (find-long-option "--root" args) device-string->file-system-device) root-fs-device)) - (root-options (if (null? root-fs-options) - #f - (file-system-options->string - root-fs-options)))) + ;; --root-options takes precedence over the 'options' field o= f the + ;; root record. + (root-options (or (find-long-option "--root-options" args) + (if (null? root-fs-options) + #f + (file-system-options->string + root-fs-options))))) =20 (when (member "--repl" args) (start-repl)) --=20 2.25.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0007-linux-boot-Filter-out-file-system-independent-option.patch >From 2cc5b27defbd2b9fd75c70482ac2ecf045b880e3 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 11 Feb 2020 14:27:19 -0500 Subject: [PATCH 7/8] linux-boot: Filter out file system independent options. This fixes an issue where options such as "defaults", which are understood by the command line program "mount", are not understood by the system call of the same name, which is used in the initial RAM disk. * gnu/system/file-systems.scm (%file-system-independent-mount-options): New variable. (file-system-independent-mount-option?): New predicate. * gnu/build/linux-boot.scm (boot-system): Use the above predicate to filter out system independent mount options. --- gnu/build/linux-boot.scm | 3 ++- gnu/system/file-systems.scm | 17 +++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index 063daa4ca4..f77eeecbe3 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -493,7 +493,8 @@ upon error." (or (and=> root-fs file-system-flags) '()))) (root-fs-options (if root-fs - (file-system-options root-fs) + (remove file-system-independent-mount-option? + (file-system-options root-fs)) '())) ;; --root takes precedence over the 'device' field of the root diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index c205feae70..4f0c5ad99e 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -46,6 +46,7 @@ file-system-location file-system-type-predicate + file-system-independent-mount-option? file-system-label file-system-label? @@ -567,4 +568,20 @@ system has the given TYPE." (lambda (fs) (string=? (file-system-type fs) type))) +(define %file-system-independent-mount-options + ;; Taken from 'man 8 mount'. + '("async" "atime" "auto" "noatime" "noauto" "context" "defaults" "dev" "nodev" + "diratime" "nodiratime" "dirsync" "exec" "noexec" "group" "iversion" + "noiversion" "mand" "nomand" "_netdev" "nofail" "relatime" "norelatime" + "strictatime" "nostrictatime" "lazytime" "nolazytime" "suid" "nosuid" + "silent" "loud" "owner" "remount" "ro" "rw" "sync" "user" "nouser" "users")) + +(define (file-system-independent-mount-option? option) + "Predicate to check if a option is file system independent." + (let ((option-name (if (pair? option) + (car option) + option))) + (or (string-prefix-ci? "x-" option-name) + (member option-name %file-system-independent-mount-options)))) + ;;; file-systems.scm ends here -- 2.25.0 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0008-bootloader-grub-Allow-booting-from-a-Btrfs-subvolume.patch Content-Transfer-Encoding: quoted-printable >From e73112a8a476f89a4728a865576dab7e8042bb47 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 14 Jul 2019 20:50:23 +0900 Subject: [PATCH 8/8] bootloader: grub: Allow booting from a Btrfs subvolume. * gnu/bootloader/grub.scm (grub-configuration-file) [btrfs-subvolume-file-name]: New parameter. When it is defined, prepend its value to the kernel and initrd file names. * gnu/bootloader/depthcharge.scm (depthcharge-configuration-file): Adapt. * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Likewise. * gnu/system/file-systems.scm (btrfs-subvolume?) (btrfs-store-subvolume-file-name): New procedures. * gnu/system.scm (operating-system-bootcfg): Specify the Btrfs subvolume file name the store resides on to the `operating-system-bootcfg' procedure, using the new BTRFS-SUBVOLUME-FILE-NAME argument. * doc/guix.texi (File Systems): Add a Btrfs subsection to document the use = of subvolumes. Document the new `properties' field of the `' record. * gnu/tests/install.scm: Add test "btrfs-root-on-subvolume-os". --- doc/guix.texi | 114 +++++++++++++++++++++++++++++++++ gnu/bootloader/depthcharge.scm | 3 +- gnu/bootloader/extlinux.scm | 3 +- gnu/bootloader/grub.scm | 45 ++++++++----- gnu/system.scm | 9 ++- gnu/system/file-systems.scm | 58 +++++++++++++++++ gnu/tests/install.scm | 96 +++++++++++++++++++++++++++ 7 files changed, 308 insertions(+), 20 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index d6bfbd7b55..f0956f965a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11442,6 +11442,13 @@ a dependency of @file{/sys/fs/cgroup/cpu} and =20 Another example is a file system that depends on a mapped device, for example for an encrypted partition (@pxref{Mapped Devices}). + +@item @code{properties} (default: @code{'()}) +This is a list of key-value pairs that can be used to specify properties +not captured by other fields. For example, the top level path of a +Btrfs subvolume within its Btrfs pool can be specified using the +@code{btrfs-subvolume-path} property (@pxref{Btrfs file system}). + @end table @end deftp =20 @@ -11491,6 +11498,113 @@ and unmount user-space FUSE file systems. This r= equires the @code{fuse.ko} kernel module to be loaded. @end defvr =20 +@node Btrfs file system +@subsection Btrfs file system + +The Btrfs has special features, such as subvolumes, that merit being +explained in more details. The following section attempts to cover +basic as well as complex uses of a Btrfs file system with the Guix +System. + +In its simplest usage, a Btrfs file system can be described, for +example, by: + +@lisp +(file-system + (mount-point "/home") + (type "btrfs") + (device (file-system-label "my-home"))) +@end lisp + +The example below is more complex, as it makes use of a Btrfs +subvolume, named @code{rootfs}. The parent Btrfs file system is labeled +@code{my-btrfs-pool}, and is located on an encrypted device (hence the +dependency on @code{mapped-devices}): + +@example +(file-system + (device (file-system-label "my-btrfs-pool")) + (mount-point "/") + (type "btrfs") + (options '("defaults" ("subvol" . "rootfs")) + (dependencies mapped-devices)) +@end example + +Some bootloaders, for example GRUB, only mount a Btrfs partition at its +top level during the early boot, and rely on their configuration to +refer to the correct subvolume path within that top level. The +bootloaders operating in this way typically produce their configuration +on a running system where the Btrfs partitions are already mounted and +where the subvolume information is readily available. As an example, +@command{grub-mkconfig}, the configuration generator command shipped +with GRUB, reads @file{/proc/self/mountinfo} to determine the top-level +path of a subvolume. + +The Guix System produces a bootloader configuration using the operating +system configuration as its sole input; it is therefore necessary to +extract the subvolume name on which @file{/gnu/store} lives (if any) +from that operating system configuration. To better illustrate, +consider a subvolume named 'rootfs' which contains the root file system +data. In such situation, the GRUB bootloader would only see the top +level of the root Btrfs partition, e.g.: + +@example +/ (top level) +=E2=94=9C=E2=94=80=E2=94=80 rootfs (subvolume directory) + =E2=94=9C=E2=94=80=E2=94=80 gnu (normal directory) + =E2=94=9C=E2=94=80=E2=94=80 store (normal directory) +[...] +@end example + +Thus, the subvolume name must be prepended to the @file{/gnu/store} path +of the kernel and initrd binaries in the GRUB configuration in order for +those to be found. + +The next example shows a nested hierarchy of subvolumes and +directories: + +@example +/ (top level) +=E2=94=9C=E2=94=80=E2=94=80 rootfs (subvolume) + =E2=94=9C=E2=94=80=E2=94=80 gnu (normal directory) + =E2=94=9C=E2=94=80=E2=94=80 store (subvolume) +[...] +@end example + +This scenario would work without mounting the 'store' subvolume. +Mounting 'rootfs' is sufficient, since the subvolume name matches its +intended mount point in the file system hierarchy. + +Finally, a more contrived example of nested subvolumes: + +@example +/ (top level) +=E2=94=9C=E2=94=80=E2=94=80 root-snapshots (subvolume) + =E2=94=9C=E2=94=80=E2=94=80 root-current (subvolume) + =E2=94=9C=E2=94=80=E2=94=80 guix-store (subvolume) +[...] +@end example + +Here, the 'guix-store' module name doesn't match its intended mount +point, so it is necessary to mount it. The layout cannot simply be +described by the record, so it is required to specify the +exact path at which the subvolume exists within the top level of its +parent file system. This can be achieved by attaching a +@code{btrfs-subvolume-path} property to the corresponding file system +record: + +@lisp +(file-system + ... + (properties '((btrfs-subvolume-path + . "/root-snapshots/root-current/guix-store")))) +@end lisp + +The default behavior of Guix is to assume that a subvolume exists +directly at the root of the top volume hierarchy. When this is not the +case, the above property must be used for the system to boot correctly +when using a GRUB based bootloader. + @node Mapped Devices @section Mapped Devices =20 diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm index 58cc3f3932..0a50374bd9 100644 --- a/gnu/bootloader/depthcharge.scm +++ b/gnu/bootloader/depthcharge.scm @@ -82,7 +82,8 @@ (define* (depthcharge-configuration-file config entries #:key (system (%current-system)) - (old-entries '())) + (old-entries '()) + #:allow-other-keys) (match entries ((entry) (let ((kernel (menu-entry-linux entry)) diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm index 5b4dd84965..6b5ff298e7 100644 --- a/gnu/bootloader/extlinux.scm +++ b/gnu/bootloader/extlinux.scm @@ -28,7 +28,8 @@ (define* (extlinux-configuration-file config entries #:key (system (%current-system)) - (old-entries '())) + (old-entries '()) + #:allow-other-keys) "Return the U-Boot configuration file corresponding to CONFIG, a object, and where the store is available at STORE-F= S, a object. OLD-ENTRIES is taken to be a list of menu entries diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index b99f5fa4f4..3ec960abd8 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -4,6 +4,7 @@ ;;; Copyright =C2=A9 2017 Leo Famulari ;;; Copyright =C2=A9 2017 Mathieu Othacehe ;;; Copyright =C2=A9 2019 Jan (janneke) Nieuwenhuizen +;;; Copyright =C2=A9 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -327,35 +328,47 @@ code." (define* (grub-configuration-file config entries #:key (system (%current-system)) - (old-entries '())) + (old-entries '()) + btrfs-subvolume-file-name) "Return the GRUB configuration file corresponding to CONFIG, a object, and where the store is available at -STORE-FS, a object. OLD-ENTRIES is taken to be a list of me= nu -entries corresponding to old generations of the system." +STORE-FS, a object. OLD-ENTRIES is taken to be a list +of menu entries corresponding to old generations of the system. +BTRFS-SUBVOLUME-FILE-NAME may be used to specify on which subvolume a +Btrfs root file system resides." (define all-entries (append entries (bootloader-configuration-menu-entries config))) (define (menu-entry->gexp entry) - (let ((device (menu-entry-device entry)) - (device-mount-point (menu-entry-device-mount-point entry)) - (label (menu-entry-label entry)) - (kernel (menu-entry-linux entry)) - (arguments (menu-entry-linux-arguments entry)) - (initrd (menu-entry-initrd entry))) + (let* ((device (menu-entry-device entry)) + (device-mount-point (menu-entry-device-mount-point entry)) + (label (menu-entry-label entry)) + (arguments (menu-entry-linux-arguments entry)) + (kernel* (strip-mount-point + device-mount-point (menu-entry-linux entry))) + (initrd* (strip-mount-point + device-mount-point (menu-entry-initrd entry))) + (kernel (if btrfs-subvolume-file-name + #~(string-append #$btrfs-subvolume-file-name #$kern= el*) + kernel*)) + (initrd (if btrfs-subvolume-file-name + #~(string-append #$btrfs-subvolume-file-name #$init= rd*) + initrd*))) ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount poin= t. ;; Use the right file names for KERNEL and INITRD in case ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a ;; separate partition. - (let ((kernel (strip-mount-point device-mount-point kernel)) - (initrd (strip-mount-point device-mount-point initrd))) - #~(format port "menuentry ~s { + + ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the kernel = and + ;; initrd paths, to allow booting from a Btrfs subvolume. + #~(format port "menuentry ~s { ~a linux ~a ~a initrd ~a }~%" - #$label - #$(grub-root-search device kernel) - #$kernel (string-join (list #$@arguments)) - #$initrd)))) + #$label + #$(grub-root-search device kernel) + #$kernel (string-join (list #$@arguments)) + #$initrd))) (define sugar (eye-candy config (menu-entry-device (first all-entries)) diff --git a/gnu/system.scm b/gnu/system.scm index 2e6d03272d..59c3526098 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -5,6 +5,7 @@ ;;; Copyright =C2=A9 2016 Chris Marusich ;;; Copyright =C2=A9 2017 Mathieu Othacehe ;;; Copyright =C2=A9 2019 Meiyo Peng +;;; Copyright =C2=A9 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -992,19 +993,23 @@ entry." (define* (operating-system-bootcfg os #:optional (old-entries '())) "Return the bootloader configuration file for OS. Use OLD-ENTRIES, a list of , to populate the \"old entries\" menu." - (let* ((root-fs (operating-system-root-file-system os)) + (let* ((file-systems (operating-system-file-systems os)) + (root-fs (operating-system-root-file-system os)) (root-device (file-system-device root-fs)) (params (operating-system-boot-parameters os root-device #:system-kernel-arguments? #t)) (entry (boot-parameters->menu-entry params)) (bootloader-conf (operating-system-bootloader os))) + (define generate-config-file (bootloader-configuration-file-generator (bootloader-configuration-bootloader bootloader-conf))) =20 (generate-config-file bootloader-conf (list entry) - #:old-entries old-entries))) + #:old-entries old-entries + #:btrfs-subvolume-file-name + (btrfs-store-subvolume-file-name file-systems)))) =20 (define* (operating-system-boot-parameters os root-device #:key system-kernel-arguments?) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 4f0c5ad99e..7b78731524 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -21,7 +21,10 @@ #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-9 gnu) #:use-module (guix records) #:use-module (gnu system uuid) @@ -44,9 +47,12 @@ file-system-create-mount-point? file-system-dependencies file-system-location + file-system-properties =20 file-system-type-predicate file-system-independent-mount-option? + btrfs-subvolume? + btrfs-store-subvolume-file-name =20 file-system-label file-system-label? @@ -112,6 +118,8 @@ (default #f)) (dependencies file-system-dependencies ; list of (default '())) ; or + (properties file-system-properties ; list of name-value pai= rs + (default '())) (location file-system-location (default (current-source-location)) (innate))) @@ -584,4 +592,54 @@ system has the given TYPE." (or (string-prefix-ci? "x-" option-name) (member option-name %file-system-independent-mount-options)))) =20 +(define (btrfs-subvolume? fs) + "Predicate to check if FS, a file-system object, is a Btrfs subvolume." + (and-let* ((btrfs-file-system? (string=3D "btrfs" (file-system-type fs))) + (option-keys (map (match-lambda + ((key . value) key) + (key key)) + (file-system-options fs)))) + (find (cut string-prefix? "subvol" <>) option-keys))) + +(define (btrfs-store-subvolume-file-name file-systems) + "Return the subvolume file name within the Btrfs top level onto +which the store is located. When the BTRFS-SUBVOLUME-FILE-NAME file +system property is not set, it is assumed that the store subvolume +file name is located at the root of the top level of the file system." + + (define (find-mount-point-fs mount-point file-systems) + (find (lambda (fs) + (string=3D mount-point (file-system-mount-point fs))) + file-systems)) + + ;; Find a subvolume mounted at either /gnu/store, /gnu, or /. + (let loop ((mount-point (%store-prefix))) + (let ((mount-point-fs (find-mount-point-fs mount-point file-systems))) + (cond + ((string-null? mount-point) + #f) ;store is not on a Btrfs subvolume + ((and=3D> mount-point-fs btrfs-subvolume?) + (let* ((fs-options (file-system-options mount-point-fs)) + (subvolid (assoc-ref fs-options "subvolid")) + (subvol (assoc-ref fs-options "subvol"))) + (or (assoc-ref (file-system-properties mount-point-fs) + "btrfs-subvolume-file-name") + (and=3D> subvol (cut string-append "/" <>)) + ;; XXX: Importing (guix utils) and using &fix-hint causes the + ;; following error when booting the init RAM disk: "ERROR: In + ;; procedure dynamic-func:\nIn procedure dynamic-pointer: Sy= mbol + ;; not found: strverscmp", so we just embed the hint in the + ;; message. + (raise (condition + (&message + (message "The store is on a Btrfs subvolume, but the \ +subvolume name is unknown.\nHint: Define the \"btrfs-subvolume-file-name\"= \ +file system property or use the \"subvol\" Btrfs file system"))))))) + (else + (loop + (cond ((string-suffix? "/" mount-point) + (string-drop-right mount-point 1)) + ((string-take mount-point + (1+ (string-index-right mount-point #\/))))))= ))))) + ;;; file-systems.scm ends here diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index d475bda2c7..82e2b46e3e 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -44,6 +44,7 @@ %test-raid-root-os %test-encrypted-root-os %test-btrfs-root-os + %test-btrfs-root-on-subvolume-os %test-jfs-root-os)) =20 ;;; Commentary: @@ -811,6 +812,101 @@ build (current-guix) and then store a couple of full = system images.") (command (qemu-command/writable-image image))) (run-basic-test %btrfs-root-os command "btrfs-root-os"))))) =20 + +;;; +;;; Btrfs root file system on a subvolume. +;;; + +(define-os-with-source (%btrfs-root-on-subvolume-os + %btrfs-root-on-subvolume-os-source) + ;; The OS we want to install. + (use-modules (gnu) (gnu tests) (srfi srfi-1)) + + (operating-system + (host-name "hurd") + (timezone "America/Montreal") + (locale "en_US.UTF-8") + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) + (kernel-arguments '("console=3DttyS0")) + (file-systems (cons* (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/") + (options '(("subvol" . "rootfs") + ("compress" . "zstd"))) + (type "btrfs")) + (file-system + (device (file-system-label "btrfs-pool")) + (mount-point "/home") + (options '(("subvol" . "homefs") + ("compress" . "lzo"))) + (type "btrfs")) + %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 %btrfs-root-on-subvolume-installation-script + ;; Shell script of a simple installation. + "\ +. /etc/profile +set -e -x +guix --version + +export GUIX_BUILD_OPTIONS=3D--no-grafts +ls -l /run/current-system/gc-roots +parted --script /dev/vdb mklabel gpt \\ + mkpart primary ext2 1M 3M \\ + mkpart primary ext2 3M 2G \\ + set 1 boot on \\ + set 1 bios_grub on + +# Setup the top level Btrfs file system with its subvolume. +mkfs.btrfs -L btrfs-pool /dev/vdb2 +mount /dev/vdb2 /mnt +btrfs subvolume create /mnt/rootfs +btrfs subvolume create /mnt/homefs +umount /dev/vdb2 + +# Mount the subvolumes, ready for installation. +mount LABEL=3Dbtrfs-pool -o 'subvol=3Drootfs,compress=3Dzstd' /mnt +mkdir /mnt/home +mount LABEL=3Dbtrfs-pool -o 'subvol=3Dhomefs,compress=3Dzstd' /mnt/home + +herd start cow-store /mnt +mkdir /mnt/etc +cp /etc/target-config.scm /mnt/etc/config.scm +guix system build /mnt/etc/config.scm +guix system init /mnt/etc/config.scm /mnt --no-substitutes +sync +reboot\n") + +(define %test-btrfs-root-on-subvolume-os + (system-test + (name "btrfs-root-on-subvolume-os") + (description + "Test basic functionality of an OS installed like one would do by hand. +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 + ((image + (run-install %btrfs-root-on-subvolume-os + %btrfs-root-on-subvolume-os-source + #:script + %btrfs-root-on-subvolume-installation-script)) + (command (qemu-command/writable-image image))) + (run-basic-test %btrfs-root-on-subvolume-os command + "btrfs-root-on-subvolume-os"))))) + ;;; ;;; JFS root file system. --=20 2.25.0 --=-=-=--