diff options
author | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2024-02-03 14:39:49 +0100 |
---|---|---|
committer | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2024-02-03 14:39:49 +0100 |
commit | e6c847defb6cb25c65172dec46a322e5d3d45088 (patch) | |
tree | 3d249dce1a1f58fcb3c83a41eaf9e1525d7b112e /gnu/system | |
parent | 3aef72ec5bf1027bc557daab7010848d80711a28 (diff) | |
parent | 179bb57d2532ee6b81791e078b0f782cbf88cb84 (diff) |
Merge branch 'master' into gnome-team
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/image.scm | 3 | ||||
-rw-r--r-- | gnu/system/mapped-devices.scm | 67 | ||||
-rw-r--r-- | gnu/system/shadow.scm | 116 |
3 files changed, 127 insertions, 59 deletions
diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 2cc1012893..5456b3a5a0 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -535,7 +535,8 @@ used in the image." (when (and (gpt-image? image) (not - (memq (bootloader-name bootloader) '(grub-efi grub-efi32)))) + (memq (bootloader-name bootloader) + '(grub-efi grub-efi32 grub-efi-removable-bootloader)))) (raise (formatted-message (G_ "EFI bootloader required with GPT partitioning")))) diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index e6b8970c12..c19a818453 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2017, 2018 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -64,6 +65,7 @@ check-device-initrd-modules ;XXX: needs a better place luks-device-mapping + luks-device-mapping-with-options raid-device-mapping lvm-device-mapping)) @@ -188,7 +190,7 @@ option of @command{guix system}.\n") ;;; Common device mappings. ;;; -(define (open-luks-device source targets) +(define* (open-luks-device source targets #:key key-file) "Return a gexp that maps SOURCE to TARGET as a LUKS device, using 'cryptsetup'." (with-imported-modules (source-module-closure @@ -198,7 +200,8 @@ option of @command{guix system}.\n") ((target) #~(let ((source #$(if (uuid? source) (uuid-bytevector source) - source))) + source)) + (keyfile #$key-file)) ;; XXX: 'use-modules' should be at the top level. (use-modules (rnrs bytevectors) ;bytevector? ((gnu build file-systems) @@ -215,29 +218,35 @@ option of @command{guix system}.\n") ;; 'cryptsetup open' requires standard input to be a tty to allow ;; for interaction but shepherd sets standard input to /dev/null; ;; thus, explicitly request a tty. - (zero? (system*/tty - #$(file-append cryptsetup-static "/sbin/cryptsetup") - "open" "--type" "luks" - - ;; Note: We cannot use the "UUID=source" syntax here - ;; because 'cryptsetup' implements it by searching the - ;; udev-populated /dev/disk/by-id directory but udev may - ;; be unavailable at the time we run this. - (if (bytevector? source) - (or (let loop ((tries-left 10)) - (and (positive? tries-left) - (or (find-partition-by-luks-uuid source) - ;; If the underlying partition is - ;; not found, try again after - ;; waiting a second, up to ten - ;; times. FIXME: This should be - ;; dealt with in a more robust way. - (begin (sleep 1) - (loop (- tries-left 1)))))) - (error "LUKS partition not found" source)) - source) - - #$target))))))) + (let ((partition + ;; Note: We cannot use the "UUID=source" syntax here + ;; because 'cryptsetup' implements it by searching the + ;; udev-populated /dev/disk/by-id directory but udev may + ;; be unavailable at the time we run this. + (if (bytevector? source) + (or (let loop ((tries-left 10)) + (and (positive? tries-left) + (or (find-partition-by-luks-uuid source) + ;; If the underlying partition is + ;; not found, try again after + ;; waiting a second, up to ten + ;; times. FIXME: This should be + ;; dealt with in a more robust way. + (begin (sleep 1) + (loop (- tries-left 1)))))) + (error "LUKS partition not found" source)) + source))) + ;; We want to fallback to the password unlock if the keyfile fails. + (or (and keyfile + (zero? (system*/tty + #$(file-append cryptsetup-static "/sbin/cryptsetup") + "open" "--type" "luks" + "--key-file" keyfile + partition #$target))) + (zero? (system*/tty + #$(file-append cryptsetup-static "/sbin/cryptsetup") + "open" "--type" "luks" + partition #$target))))))))) (define (close-luks-device source targets) "Return a gexp that closes TARGET, a LUKS device." @@ -276,6 +285,14 @@ option of @command{guix system}.\n") (close close-luks-device) (check check-luks-device))) +(define* (luks-device-mapping-with-options #:key key-file) + "Return a luks-device-mapping object with open modified to pass the arguments +into the open-luks-device procedure." + (mapped-device-kind + (inherit luks-device-mapping) + (open (λ (source targets) (open-luks-device source targets + #:key-file key-file))))) + (define (open-raid-device sources targets) "Return a gexp that assembles SOURCES (a list of devices) to the RAID device TARGET (e.g., \"/dev/md0\"), using 'mdadm'." diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 47f19551b6..8b3958ba5c 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -64,6 +64,13 @@ user-group-system?) #:export (%default-bashrc + %default-bash-profile + %default-zprofile + %default-xdefaults + %default-gdbinit + %default-nanorc + %default-dotguile + %default-skeleton-home-config default-skeletons skeleton-directory %base-groups @@ -147,11 +154,8 @@ alias ll='ls -l' alias grep='grep --color=auto' alias ip='ip -color=auto'\n")) -(define (default-skeletons) - "Return the default skeleton files for /etc/skel. These files are copied by -'useradd' in the home directory of newly created user accounts." - - (let ((profile (plain-file "bash_profile" "\ +(define %default-bash-profile + (plain-file "bash_profile" "\ # Set up Guix Home profile if [ -f ~/.profile ]; then . ~/.profile; fi @@ -167,25 +171,23 @@ eval \"$(guix package --search-paths \\ # Prepend setuid programs. export PATH=/run/setuid-programs:$PATH ")) - (bashrc %default-bashrc) - (zprofile (plain-file "zprofile" "\ -# Honor system-wide environment variables -source /etc/profile - -# Merge search-paths from multiple profiles, the order matters. -eval \"$(guix package --search-paths \\ --p $HOME/.config/guix/current \\ --p $HOME/.guix-profile \\ --p /run/current-system/profile)\" -# Prepend setuid programs. -export PATH=/run/setuid-programs:$PATH +(define %default-zprofile + (plain-file "zprofile" "\ +# Set up the system, user profile, and related variables. +source /etc/profile +# Set up the home environment profile. +source ~/.profile ")) - (xdefaults (plain-file "Xdefaults" "\ + +(define %default-xdefaults + (plain-file "Xdefaults" "\ XTerm*utf8: always XTerm*metaSendsEscape: true\n")) - (gdbinit (plain-file "gdbinit" "\ -# Tell GDB where to look for separate debugging files. + +(define %default-gdbinit + (plain-file "gdbinit" + "# Tell GDB where to look for separate debugging files. guile (use-modules (gdb)) (execute (string-append \"set debug-file-directory \" @@ -203,19 +205,16 @@ end # Authorize extensions found in the store, such as the # pretty-printers of libstdc++. -set auto-load safe-path /gnu/store/*/lib\n"))) - `((".bash_profile" ,profile) - (".bashrc" ,bashrc) - ;; Zsh sources ~/.zprofile before ~/.zshrc, and it sources ~/.zlogin - ;; after ~/.zshrc. To avoid interfering with any customizations a user - ;; may have made in their ~/.zshrc, put this in .zprofile, not .zlogin. - (".zprofile" ,zprofile) - (".nanorc" ,(plain-file "nanorc" "\ -# Include all the syntax highlighting modules. +set auto-load safe-path /gnu/store/*/lib\n")) + +(define %default-nanorc + (plain-file "nanorc" + "# Include all the syntax highlighting modules. include /run/current-system/profile/share/nano/*.nanorc\n")) - (".Xdefaults" ,xdefaults) - (".guile" ,(plain-file "dot-guile" - "(cond ((false-if-exception (resolve-interface '(ice-9 readline))) + +(define %default-dotguile + (plain-file "dot-guile" + "(cond ((false-if-exception (resolve-interface '(ice-9 readline))) => (lambda (module) ;; Enable completion and input history at the REPL. @@ -233,7 +232,58 @@ convenient interactive line editing and input history.\\n\\n\"))) (else (display \"Consider installing the 'guile-colorized' package for a colorful Guile experience.\\n\\n\"))))\n")) - (".gdbinit" ,gdbinit)))) + +(define %default-skeleton-home-config + (plain-file "default-home-config" "\ +;; This is a sample Guix Home configuration which can help setup your +;; home directory in the same declarative manner as Guix System. +;; For more information, see the Home Configuration section of the manual. +(define-module (guix-home-config) + #:use-module (gnu home) + #:use-module (gnu home services) + #:use-module (gnu home services shells) + #:use-module (gnu services) + #:use-module (gnu system shadow)) + +(define home-config + (home-environment + (services + (list + ;; Uncomment the shell you wish to use for your user: + ;(service home-bash-service-type) + ;(service home-fish-service-type) + ;(service home-zsh-service-type) + + (service home-files-service-type + `((\".guile\" ,%default-dotguile) + (\".Xdefaults\" ,%default-xdefaults))) + + (service home-xdg-configuration-files-service-type + `((\"gdb/gdbinit\" ,%default-gdbinit) + (\"nano/nanorc\" ,%default-nanorc))))))) + +home-config")) + +(define (default-skeletons) + "Return the default skeleton files for /etc/skel. These files are copied by +'useradd' in the home directory of newly created user accounts." + + (let ((profile %default-bash-profile) + (bashrc %default-bashrc) + (zprofile %default-zprofile) + (xdefaults %default-xdefaults) + (gdbinit %default-gdbinit)) + `((".bash_profile" ,profile) + (".bashrc" ,bashrc) + ;; Zsh sources ~/.zprofile before ~/.zshrc, and it sources ~/.zlogin + ;; after ~/.zshrc. To avoid interfering with any customizations a user + ;; may have made in their ~/.zshrc, put this in .zprofile, not .zlogin. + (".zprofile" ,zprofile) + (".nanorc" ,%default-nanorc) + (".Xdefaults" ,xdefaults) + (".guile" ,%default-dotguile) + (".gdbinit" ,gdbinit) + ("guix-home-config.scm" ,%default-skeleton-home-config)))) (define (skeleton-directory skeletons) "Return a directory containing SKELETONS, a list of name/derivation tuples." |