diff options
Diffstat (limited to 'gnu/build')
| -rw-r--r-- | gnu/build/activation.scm | 26 | ||||
| -rw-r--r-- | gnu/build/file-systems.scm | 62 |
2 files changed, 79 insertions, 9 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index c6c7e7fd3b..30f5e87d5a 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -247,7 +247,19 @@ they already exist." string<?)) (mkdir-p %setuid-directory)) - (for-each make-setuid-program programs)) + (for-each (lambda (program) + (catch 'system-error + (lambda () + (make-setuid-program program)) + (lambda args + ;; If we fail to create a setuid program, better keep going + ;; so that we don't leave %SETUID-DIRECTORY empty or + ;; half-populated. This can happen if PROGRAMS contains + ;; incorrect file names: <https://bugs.gnu.org/38800>. + (format (current-error-port) + "warning: failed to make '~a' setuid-root: ~a~%" + program (strerror (system-error-errno args)))))) + programs)) (define (activate-special-files special-files) "Install the files listed in SPECIAL-FILES. Each element of SPECIAL-FILES @@ -269,9 +281,13 @@ second element is the name it should appear at, such as: (define (activate-modprobe modprobe) "Tell the kernel to use MODPROBE to load modules." - (call-with-output-file "/proc/sys/kernel/modprobe" - (lambda (port) - (display modprobe port)))) + + ;; If the kernel was built without loadable module support, this file is + ;; unavailable, so check for its existence first. + (when (file-exists? "/proc/sys/kernel/modprobe") + (call-with-output-file "/proc/sys/kernel/modprobe" + (lambda (port) + (display modprobe port))))) (define (activate-firmware directory) "Tell the kernel to look for device firmware under DIRECTORY. This diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 13c44aa728..ee6375515f 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -3,6 +3,8 @@ ;;; Copyright © 2016, 2017 David Craven <david@craven.ch> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net> +;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr> +;;; Copyright © 2019 David C. Trudgian <dave@trudgian.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -296,6 +298,45 @@ string. Trailing spaces are trimmed." ;;; +;;; JFS file systems. +;;; + +;; Taken from <linux-libre>/fs/jfs/jfs_superblock.h. + +(define-syntax %jfs-endianness + ;; Endianness of JFS file systems. + (identifier-syntax (endianness little))) + +(define (jfs-superblock? sblock) + "Return #t when SBLOCK is a JFS superblock." + (bytevector=? (sub-bytevector sblock 0 4) + (string->utf8 "JFS1"))) + +(define (read-jfs-superblock device) + "Return the raw contents of DEVICE's JFS superblock as a bytevector, or #f +if DEVICE does not contain a JFS file system." + (read-superblock device 32768 184 jfs-superblock?)) + +(define (jfs-superblock-uuid sblock) + "Return the UUID of JFS superblock SBLOCK as a 16-byte bytevector." + (sub-bytevector sblock 136 16)) + +(define (jfs-superblock-volume-name sblock) + "Return the volume name of SBLOCK as a string of at most 16 characters, or +#f if SBLOCK has no volume name." + (null-terminated-latin1->string (sub-bytevector sblock 152 16))) + +(define (check-jfs-file-system device) + "Return the health of a JFS file system on DEVICE." + (match (status:exit-val + (system* "jfs_fsck" "-p" "-v" device)) + (0 'pass) + (1 'errors-corrected) + (2 'reboot-required) + (_ 'fatal-error))) + + +;;; ;;; LUKS encrypted devices. ;;; @@ -303,6 +344,10 @@ string. Trailing spaces are trimmed." ;; <https://gitlab.com/cryptsetup/cryptsetup/wikis/Specification>. We follow ;; version 1.2.1 of this document. +;; The LUKS2 header format is described in "LUKS2 On-Disk Format Specification": +;; <https://gitlab.com/cryptsetup/LUKS2-docs/blob/master/luks2_doc_wip.pdf>. +;; It is a WIP document. + (define-syntax %luks-endianness ;; Endianness of LUKS headers. (identifier-syntax (endianness big))) @@ -316,12 +361,16 @@ string. Trailing spaces are trimmed." (let ((magic (sub-bytevector sblock 0 6)) (version (bytevector-u16-ref sblock 6 %luks-endianness))) (and (bytevector=? magic %luks-magic) - (= version 1)))) + (or (= version 1) (= version 2))))) (define (read-luks-header file) "Read a LUKS header from FILE. Return the raw header on success, and #f if not valid header was found." - ;; Size in bytes of the LUKS header, including key slots. + ;; Size in bytes of the LUKS binary header, which includes key slots in + ;; LUKS1. In LUKS2 the binary header is partially backward compatible, so + ;; that UUID can be extracted as for LUKS1. Keyslots and other metadata are + ;; not part of this header in LUKS2, but are included in the JSON metadata + ;; area that follows. (read-superblock file 0 592 luks-superblock?)) (define (luks-header-uuid header) @@ -420,7 +469,9 @@ partition field reader that returned a value." (partition-field-reader read-fat32-superblock fat32-superblock-volume-name) (partition-field-reader read-fat16-superblock - fat16-superblock-volume-name))) + fat16-superblock-volume-name) + (partition-field-reader read-jfs-superblock + jfs-superblock-volume-name))) (define %partition-uuid-readers (list (partition-field-reader read-iso9660-superblock @@ -432,7 +483,9 @@ partition field reader that returned a value." (partition-field-reader read-fat32-superblock fat32-superblock-uuid) (partition-field-reader read-fat16-superblock - fat16-superblock-uuid))) + fat16-superblock-uuid) + (partition-field-reader read-jfs-superblock + jfs-superblock-uuid))) (define read-partition-label (cut read-partition-field <> %partition-label-readers)) @@ -527,6 +580,7 @@ were found." ((string-prefix? "ext" type) check-ext2-file-system) ((string-prefix? "btrfs" type) check-btrfs-file-system) ((string-suffix? "fat" type) check-fat-file-system) + ((string-prefix? "jfs" type) check-jfs-file-system) (else #f))) (if check-procedure |