diff options
author | Ludovic Courtès <ludo@gnu.org> | 2024-01-17 10:37:40 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2024-01-17 10:37:40 +0100 |
commit | a63c2e5f8858968dda1844b87b9024914925257b (patch) | |
tree | 6584431d8d0c88cd7c03d006645aa24762dfe1fc /gnu/system | |
parent | 07b9275490c9a23fd557c4292acaf643fbab20cf (diff) | |
parent | 299ce524c9f725549ab5548197cc88b085bba2f4 (diff) |
Merge branch 'master' into core-updates
Change-Id: Ide7e5cf1c651f193994c02305b6baa4bea4e165f
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/hurd.scm | 4 | ||||
-rw-r--r-- | gnu/system/image.scm | 41 | ||||
-rw-r--r-- | gnu/system/mapped-devices.scm | 67 | ||||
-rw-r--r-- | gnu/system/shadow.scm | 116 |
4 files changed, 155 insertions, 73 deletions
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 3b138bef65..cbe0081382 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -70,7 +70,7 @@ ;; Note: the Shepherd comes before the Hurd, not just because its duty is to ;; shepherd the herd, but also because we want its 'halt' and 'reboot' ;; commands to take precedence. - (list shepherd-0.8 hurd netdde bash coreutils file findutils grep sed + (list shepherd-0.10 hurd netdde bash coreutils file findutils grep sed diffutils patch gawk tar gzip bzip2 xz lzip guile-3.0-latest guile-colorized guile-readline net-base nss-certs inetutils less procps shadow sudo which diff --git a/gnu/system/image.scm b/gnu/system/image.scm index b825892232..2cc1012893 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org> ;;; Copyright © 2022 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -686,7 +687,8 @@ returns an image record where the first partition's label is set to <label>." (define* (system-docker-image image #:key - (name "docker-image")) + (name "docker-image") + (archiver tar)) "Build a docker image for IMAGE. NAME is the base name to use for the output file." (define boot-program @@ -731,6 +733,7 @@ output file." (use-modules (guix docker) (guix build utils) (gnu build image) + (srfi srfi-1) (srfi srfi-19) (guix build store-copy) (guix store database)) @@ -754,18 +757,30 @@ output file." #:register-closures? #$register-closures? #:deduplicate? #f #:system-directory #$os) - (build-docker-image - #$output - (cons* image-root - (map store-info-item - (call-with-input-file #$graph - read-reference-graph))) - #$os - #:entry-point '(#$boot-program #$os) - #:compressor '(#+(file-append gzip "/bin/gzip") "-9n") - #:creation-time (make-time time-utc 0 1) - #:system #$image-target - #:transformations `((,image-root -> "")))))))) + (when #$(image-max-layers image) + (setenv "PATH" + (string-join (list #+(file-append archiver "/bin") + #+(file-append gzip "/bin")) + ":"))) + (apply build-docker-image + (append (list #$output + (append (if #$(image-max-layers image) + '() + (list image-root)) + (map store-info-item + (call-with-input-file #$graph + read-reference-graph))) + #$os + #:entry-point '(#$boot-program #$os) + #:compressor + '(#+(file-append gzip "/bin/gzip") "-9n") + #:creation-time (make-time time-utc 0 1) + #:system #$image-target + #:transformations `((,image-root -> ""))) + (if #$(image-max-layers image) + (list #:root-system image-root + #:max-layers #$(image-max-layers image)) + '())))))))) (computed-file name builder ;; Allow offloading so that this I/O-intensive process 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." |