diff options
author | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-26 18:35:14 +0200 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-26 18:35:14 +0200 |
commit | 17dddeeee560527a8f30d37761949d658056cb09 (patch) | |
tree | 15b0b19c55787f556eb9b42c28d173bddc5435db /gnu/system | |
parent | 331a09654eb7e9f6212b7e8469077fa7393e8b11 (diff) | |
parent | 6a9581741e4ee81226aeb2f1c997df76670a6aab (diff) |
Merge remote-tracking branch 'origin/master' into core-updates
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/examples/desktop.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/file-systems.scm | 46 | ||||
-rw-r--r-- | gnu/system/image.scm | 9 | ||||
-rw-r--r-- | gnu/system/install.scm | 1 | ||||
-rw-r--r-- | gnu/system/linux-initrd.scm | 72 | ||||
-rw-r--r-- | gnu/system/mapped-devices.scm | 36 | ||||
-rw-r--r-- | gnu/system/uuid.scm | 37 |
7 files changed, 148 insertions, 55 deletions
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl index 3931bad60d..716b9feb8d 100644 --- a/gnu/system/examples/desktop.tmpl +++ b/gnu/system/examples/desktop.tmpl @@ -42,9 +42,11 @@ (type "vfat"))) %base-file-systems)) + ;; Create user `bob' with `alice' as its initial password. (users (cons (user-account (name "bob") (comment "Alice's brother") + (password (crypt "alice" "$6$abc")) (group "users") (supplementary-groups '("wheel" "netdev" "audio" "video"))) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 0f94577760..5c02dfac93 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.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 © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; @@ -28,6 +28,8 @@ #:use-module (srfi srfi-35) #:use-module (srfi srfi-9 gnu) #:use-module (guix records) + #:use-module ((guix diagnostics) #:select (&fix-hint)) + #:use-module (guix i18n) #:use-module (gnu system uuid) #:re-export (uuid ;backward compatibility string->uuid @@ -46,6 +48,7 @@ alist->file-system-options file-system-mount? + file-system-mount-may-fail? file-system-check? file-system-create-mount-point? file-system-dependencies @@ -66,6 +69,8 @@ %pseudo-file-system-types %fuse-control-file-system %binary-format-file-system + %debug-file-system + %efivars-file-system %shared-memory-file-system %pseudo-terminal-file-system %tty-gid @@ -111,6 +116,8 @@ (default #f)) (mount? file-system-mount? ; Boolean (default #t)) + (mount-may-fail? file-system-mount-may-fail? ; Boolean + (default #f)) (needed-for-boot? %file-system-needed-for-boot? ; Boolean (default #f)) (check? file-system-check? ; Boolean @@ -298,18 +305,21 @@ store--e.g., if FS is the root file system." "Return a list corresponding to file-system FS that can be passed to the initrd code." (match fs - (($ <file-system> device mount-point type flags options _ _ check?) + (($ <file-system> device mount-point type flags options mount? + mount-may-fail? needed-for-boot? check?) + ;; Note: Add new fields towards the end for compatibility. (list (cond ((uuid? device) `(uuid ,(uuid-type device) ,(uuid-bytevector device))) ((file-system-label? device) `(file-system-label ,(file-system-label->string device))) (else device)) - mount-point type flags options check?)))) + mount-point type flags options mount-may-fail? check?)))) (define (spec->file-system sexp) "Deserialize SEXP, a list, to the corresponding <file-system> object." (match sexp - ((device mount-point type flags options check?) + ((device mount-point type flags options mount-may-fail? check? + _ ...) ;placeholder for new fields (file-system (device (match device (('uuid (? symbol? type) (? bytevector? bv)) @@ -320,6 +330,7 @@ initrd code." device))) (mount-point mount-point) (type type) (flags flags) (options options) + (mount-may-fail? mount-may-fail?) (check? check?))))) (define (specification->file-system-mapping spec writable?) @@ -366,6 +377,24 @@ TARGET in the other system." (type "binfmt_misc") (check? #f))) +(define %debug-file-system + (file-system + (type "debugfs") + (device "none") + (mount-point "/sys/kernel/debug") + (check? #f) + (create-mount-point? #t))) + +(define %efivars-file-system + ;; Support for EFI variables file system. + (file-system + (device "efivarfs") + (mount-point "/sys/firmware/efi/efivars") + (type "efivarfs") + (mount-may-fail? #t) + (needed-for-boot? #f) + (check? #f))) + (define %tty-gid ;; ID of the 'tty' group. Allocate it statically to make it easy to refer ;; to it from here and from the 'tty' group definitions. @@ -465,7 +494,9 @@ TARGET in the other system." ;; List of basic file systems to be mounted. Note that /proc and /sys are ;; currently mounted by the initrd. (list %pseudo-terminal-file-system + %debug-file-system %shared-memory-file-system + %efivars-file-system %immutable-store)) ;; File systems for Linux containers differ from %base-file-systems in that @@ -613,12 +644,13 @@ store is located, else #f." ;; XXX: Deriving the subvolume name based from a subvolume ID is not ;; supported, as we'd need to query the actual file system. (or (and=> (assoc-ref options "subvol") prepend-slash/maybe) - ;; FIXME: Use &fix-hint once it no longer pulls in (guix utils). (raise (condition (&message (message "The store is on a Btrfs subvolume, but the \ -subvolume name is unknown. -Hint: Use the \"subvol\" Btrfs file system option."))))))) +subvolume name is unknown.")) + (&fix-hint + (hint + (G_ "Use the @code{subvol} Btrfs file system option.")))))))) ;;; file-systems.scm ends here diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 36f56e237d..c1a718d607 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -266,7 +266,8 @@ used in the image." #$output image-root))))) (computed-file "partition.img" image-builder - #:options `(#:references-graphs ,inputs)))) + #:options `(#:local-build? #t ;typically large file + #:references-graphs ,inputs)))) (define (partition->config partition) ;; Return the genimage partition configuration for PARTITION. @@ -324,7 +325,8 @@ image ~a { #~(symlink (string-append #$image-dir "/" #$genimage-name) #$output) - #:options `(#:substitutable? ,substitutable?)))) + #:options `(#:local-build? #t ;typically large file + #:substitutable? ,substitutable?)))) ;; @@ -401,7 +403,8 @@ used in the image. " #:volume-id #$root-label #:volume-uuid #$root-uuid))))) (computed-file name builder - #:options `(#:references-graphs ,inputs + #:options `(#:local-build? #t ;typically large file + #:references-graphs ,inputs #:substitutable? ,substitutable?)))) diff --git a/gnu/system/install.scm b/gnu/system/install.scm index d0ff2e7c52..a87c2f4207 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -497,6 +497,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m ;; elogind's cgroup file systems. (list %pseudo-terminal-file-system %shared-memory-file-system + %efivars-file-system %immutable-store))) (users (list (user-account diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 0971ec29e2..b8a30c0abc 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -77,6 +77,9 @@ the derivations referenced by EXP are automatically copied to the initrd." (program-file "init" exp #:guile guile)) (define builder + ;; Do not use "guile-zlib" extension here, otherwise it would drag the + ;; non-static "zlib" package to the initrd closure. It is not needed + ;; anyway because the modules are stored uncompressed within the initrd. (with-imported-modules (source-module-closure '((gnu build linux-initrd))) #~(begin @@ -111,34 +114,49 @@ the derivations referenced by EXP are automatically copied to the initrd." (define (flat-linux-module-directory linux modules) "Return a flat directory containing the Linux kernel modules listed in MODULES and taken from LINUX." - (define build-exp - (with-imported-modules (source-module-closure - '((gnu build linux-modules))) - #~(begin - (use-modules (gnu build linux-modules) - (srfi srfi-1) - (srfi srfi-26)) - - (define module-dir - (string-append #$linux "/lib/modules")) + (define imported-modules + (source-module-closure '((gnu build linux-modules) + (guix build utils)))) - (define modules - (let* ((lookup (cut find-module-file module-dir <>)) - (modules (map lookup '#$modules))) - (append modules - (recursive-module-dependencies modules - #:lookup-module lookup)))) - - (mkdir #$output) - (for-each (lambda (module) - (format #t "copying '~a'...~%" module) - (copy-file module - (string-append #$output "/" - (basename module)))) - (delete-duplicates modules)) - - ;; Hyphen or underscore? This database tells us. - (write-module-name-database #$output)))) + (define build-exp + (with-imported-modules imported-modules + (with-extensions (list guile-zlib) + #~(begin + (use-modules (gnu build linux-modules) + (guix build utils) + (srfi srfi-1) + (srfi srfi-26)) + + (define module-dir + (string-append #$linux "/lib/modules")) + + (define modules + (let* ((lookup (cut find-module-file module-dir <>)) + (modules (map lookup '#$modules))) + (append modules + (recursive-module-dependencies + modules + #:lookup-module lookup)))) + + (define (maybe-uncompress file) + ;; If FILE is a compressed module, uncompress it, as the initrd + ;; is already gzipped as a whole. + (cond + ((string-contains file ".ko.gz") + (invoke #+(file-append gzip "/bin/gunzip") file)))) + + (mkdir #$output) + (for-each (lambda (module) + (let ((out-module + (string-append #$output "/" + (basename module)))) + (format #t "copying '~a'...~%" module) + (copy-file module out-module) + (maybe-uncompress out-module))) + (delete-duplicates modules)) + + ;; Hyphen or underscore? This database tells us. + (write-module-name-database #$output))))) (computed-file "linux-modules" build-exp)) diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index c3f98302ad..31c50c4e40 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -23,8 +23,9 @@ #:use-module (guix records) #:use-module ((guix modules) #:hide (file-name->module-name)) #:use-module (guix i18n) - #:use-module ((guix utils) + #:use-module ((guix diagnostics) #:select (source-properties->location + formatted-message &fix-hint &error-location)) #:use-module (gnu services) @@ -132,13 +133,13 @@ DEVICE must be a \"/dev\" file name." ;; "usb_storage"), not file names (e.g., "usb-storage.ko"). This is ;; OK because we have machinery that accepts both the hyphen and the ;; underscore version. - (raise (condition - (&message - (message (format #f (G_ "you may need these modules \ + (raise (make-compound-condition + (formatted-message (G_ "you may need these modules \ in the initrd for ~a:~{ ~a~}") - device missing))) - (&fix-hint - (hint (format #f (G_ "Try adding them to the + device missing) + (condition + (&fix-hint + (hint (format #f (G_ "Try adding them to the @code{initrd-modules} field of your @code{operating-system} declaration, along these lines: @@ -151,9 +152,10 @@ these lines: If you think this diagnostic is inaccurate, use the @option{--skip-checks} option of @command{guix system}.\n") - missing))) - (&error-location - (location (source-properties->location location))))))) + missing)))) + (condition + (&error-location + (location (source-properties->location location)))))))) ;;; @@ -215,13 +217,13 @@ option of @command{guix system}.\n") (if (uuid? source) (match (find-partition-by-luks-uuid (uuid-bytevector source)) (#f - (raise (condition - (&message - (message (format #f (G_ "no LUKS partition with UUID '~a'") - (uuid->string source)))) - (&error-location - (location (source-properties->location - (mapped-device-location md))))))) + (raise (make-compound-condition + (formatted-message (G_ "no LUKS partition with UUID '~a'") + (uuid->string source)) + (condition + (&error-location + (location (source-properties->location + (mapped-device-location md)))))))) ((? string? device) (check-device-initrd-modules device initrd-modules location))) (check-device-initrd-modules source initrd-modules location))))) diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm index bc3af69610..c8352f4933 100644 --- a/gnu/system/uuid.scm +++ b/gnu/system/uuid.scm @@ -45,6 +45,7 @@ string->btrfs-uuid string->fat-uuid string->jfs-uuid + string->ntfs-uuid iso9660-uuid->string ;; XXX: For lack of a better place. @@ -197,6 +198,38 @@ ISO9660 UUID representation." ;;; +;;; NTFS. +;;; + +(define-syntax %ntfs-endianness + ;; Endianness of NTFS file system. + (identifier-syntax (endianness little))) + +(define (ntfs-uuid->string uuid) + "Convert NTFS UUID, a 8-byte bytevector, to its string representation." + (format #f "~{~:@(~x~)~}" (reverse (bytevector->u8-list uuid)))) + +(define %ntfs-uuid-rx + (make-regexp "^([[:xdigit:]]{16})$")) + +(define (string->ntfs-uuid str) + "Parse STR, which is in NTFS format, and return a bytevector or #f." + (match (regexp-exec %ntfs-uuid-rx str) + (#f + #f) + (rx-match + (u8-list->bytevector + (let loop ((str str) + (res '())) + (if (string=? str "") + res + (loop (string-drop str 2) + (cons + (string->number (string-take str 2) 16) + res)))))))) + + +;;; ;;; Generic interface. ;;; @@ -220,13 +253,15 @@ ISO9660 UUID representation." (vhashq ('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => string->dce-uuid) ('fat32 'fat16 'fat => string->fat-uuid) + ('ntfs => string->ntfs-uuid) ('iso9660 => string->iso9660-uuid))) (define %uuid-printers (vhashq ('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => dce-uuid->string) ('iso9660 => iso9660-uuid->string) - ('fat32 'fat16 'fat => fat-uuid->string))) + ('fat32 'fat16 'fat => fat-uuid->string) + ('ntfs => ntfs-uuid->string))) (define* (string->uuid str #:optional (type 'dce)) "Parse STR as a UUID of the given TYPE. On success, return the |