From b1a505baf61cc771197eb44af9173f31d2bace46 Mon Sep 17 00:00:00 2001 From: David Craven Date: Wed, 30 Nov 2016 19:30:12 +0100 Subject: system: Add btrfs file system support. * gnu/build/file-systems.scm (%btrfs-endianness, btrfs-superblock?, read-btrfs-superblock, btrfs-superblock-uuid, btrfs-superblock-volume-name, check-btrfs-file-system): New variables. (%paritition-label-readers, %partition-uuid-readers): Add btrfs readers. * gnu/system/linux-initrd.scm (linux-modules): Add btrfs modules when a btrfs file-system is used. * gnu/tests/install.scm (%btrfs-root-os %btrfs-root-os-source, %btrfs-root-installation-script, %test-btrfs-root-os): New system test. * doc/guix.texi: Adjust accordingly. Fixes . --- gnu/build/file-systems.scm | 46 +++++++++++++++++++++++++-- gnu/system/linux-initrd.scm | 6 ++++ gnu/tests/install.scm | 77 ++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 126 insertions(+), 3 deletions(-) (limited to 'gnu') diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index e76854490c..6e5c6aaf15 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -144,6 +144,43 @@ (define (check-ext2-file-system device) (2 'reboot-required) (_ 'fatal-error))) + +;;; +;;; Btrfs file systems. +;;; + +;; . + +(define-syntax %btrfs-endianness + ;; Endianness of btrfs file systems. + (identifier-syntax (endianness little))) + +(define (btrfs-superblock? sblock) + "Return #t when SBLOCK is a btrfs superblock." + (bytevector=? (sub-bytevector sblock 64 8) + (string->utf8 "_BHRfS_M"))) + +(define (read-btrfs-superblock device) + "Return the raw contents of DEVICE's btrfs superblock as a bytevector, or #f +if DEVICE does not contain a btrfs file system." + (read-superblock device 65536 4096 btrfs-superblock?)) + +(define (btrfs-superblock-uuid sblock) + "Return the UUID of a btrfs superblock SBLOCK as a 16-byte bytevector." + (sub-bytevector sblock 32 16)) + +(define (btrfs-superblock-volume-name sblock) + "Return the volume name of SBLOCK as a string of at most 256 characters, or +#f if SBLOCK has no volume name." + (null-terminated-latin1->string (sub-bytevector sblock 299 256))) + +(define (check-btrfs-file-system device) + "Return the health of a btrfs file system on DEVICE." + (match (status:exit-val + (system* "btrfs" "device" "scan")) + (0 'pass) + (_ 'fatal-error))) + ;;; ;;; LUKS encrypted devices. @@ -257,11 +294,15 @@ (define (read-partition-field device partition-field-readers) (define %partition-label-readers (list (partition-field-reader read-ext2-superblock - ext2-superblock-volume-name))) + ext2-superblock-volume-name) + (partition-field-reader read-btrfs-superblock + btrfs-superblock-volume-name))) (define %partition-uuid-readers (list (partition-field-reader read-ext2-superblock - ext2-superblock-uuid))) + ext2-superblock-uuid) + (partition-field-reader read-btrfs-superblock + btrfs-superblock-uuid))) (define read-partition-label (cut read-partition-field <> %partition-label-readers)) @@ -428,6 +469,7 @@ (define (check-file-system device type) (define check-procedure (cond ((string-prefix? "ext" type) check-ext2-file-system) + ((string-prefix? "btrfs" type) check-btrfs-file-system) (else #f))) (if check-procedure diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index a787072ba7..4a753cdadb 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -197,6 +197,9 @@ (define linux-modules ,@(if (find (file-system-type-predicate "vfat") file-systems) '("nls_iso8859-1") '()) + ,@(if (find (file-system-type-predicate "btrfs") file-systems) + '("btrfs") + '()) ,@(if volatile-root? '("fuse") '()) @@ -214,6 +217,9 @@ (define helper-packages file-systems) (list fatfsck/static) '()) + ,@(if (find (file-system-type-predicate "btrfs") file-systems) + (list btrfs-progs/static) + '()) ,@(if volatile-root? (list unionfs-fuse/static) '()))) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 4779b80e94..ae54154c5c 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -36,7 +36,8 @@ (define-module (gnu tests install) #:export (%test-installed-os %test-separate-store-os %test-raid-root-os - %test-encrypted-os)) + %test-encrypted-os + %test-btrfs-root-os)) ;;; Commentary: ;;; @@ -518,4 +519,78 @@ (define %test-encrypted-os (run-basic-test %encrypted-root-os command "encrypted-root-os" #:initialization enter-luks-passphrase))))) + +;;; +;;; Btrfs root file system. +;;; + +(define-os-with-source (%btrfs-root-os %btrfs-root-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 (grub-configuration (device "/dev/vdb"))) + (kernel-arguments '("console=ttyS0")) + (file-systems (cons (file-system + (device "my-root") + (title 'label) + (mount-point "/") + (type "btrfs")) + %base-file-systems)) + (users (cons (user-account + (name "charlie") + (group "users") + (home-directory "/home/charlie") + (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-installation-script + ;; Shell script of a simple installation. + "\ +. /etc/profile +set -e -x +guix --version + +export GUIX_BUILD_OPTIONS=--no-grafts +ls -l /run/current-system/gc-roots +parted --script /dev/vdb mklabel gpt \\ + mkpart primary ext2 1M 3M \\ + mkpart primary ext2 3M 1G \\ + set 1 boot on \\ + set 1 bios_grub on +mkfs.btrfs -L my-root /dev/vdb2 +mount /dev/vdb2 /mnt +btrfs subvolume create /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-os + (system-test + (name "btrfs-root-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-os + %btrfs-root-os-source + #:script + %btrfs-root-installation-script)) + (command (qemu-command/writable-image image))) + (run-basic-test %btrfs-root-os command "btrfs-root-os"))))) + ;;; install.scm ends here -- cgit v1.2.3