X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/112024826d3283284654475a50ccef81c697e2c9..91fd8dd2c5ebb8984cb939e4c12c4a0a1b07a86f:/gnu/system.scm diff --git a/gnu/system.scm b/gnu/system.scm index 5be24ba586..d6bf6c413c 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -43,7 +43,6 @@ #:use-module (gnu packages texinfo) #:use-module (gnu packages compression) #:use-module (gnu packages firmware) - #:autoload (gnu packages cryptsetup) (cryptsetup) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services base) @@ -54,6 +53,7 @@ #:use-module (gnu system pam) #:use-module (gnu system linux-initrd) #:use-module (gnu system file-systems) + #:use-module (gnu system mapped-devices) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -81,7 +81,11 @@ operating-system-mapped-devices operating-system-file-systems operating-system-store-file-system + operating-system-user-mapped-devices + operating-system-boot-mapped-devices operating-system-activation-script + operating-system-user-accounts + operating-system-shepherd-service-names operating-system-derivation operating-system-profile @@ -101,9 +105,7 @@ local-host-aliases %setuid-programs %base-packages - %base-firmware - - luks-device-mapping)) + %base-firmware)) ;;; Commentary: ;;; @@ -176,24 +178,6 @@ ;;; Services. ;;; -(define (open-luks-device source target) - "Return a gexp that maps SOURCE to TARGET as a LUKS device, using -'cryptsetup'." - #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") - "open" "--type" "luks" - #$source #$target))) - -(define (close-luks-device source target) - "Return a gexp that closes TARGET, a LUKS device." - #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") - "close" #$target))) - -(define luks-device-mapping - ;; The type of LUKS mapped devices. - (mapped-device-kind - (open open-luks-device) - (close close-luks-device))) - (define (other-file-system-services os) "Return file system services for the file systems of OS that are not marked as 'needed-for-boot'." @@ -226,8 +210,9 @@ as 'needed-for-boot'." "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f." (let ((target (string-append "/dev/mapper/" (mapped-device-target device)))) (find (lambda (fs) - (and (eq? 'device (file-system-title fs)) - (string=? (file-system-device fs) target))) + (or (member device (file-system-dependencies fs)) + (and (eq? 'device (file-system-title fs)) + (string=? (file-system-device fs) target)))) file-systems))) (define (operating-system-user-mapped-devices os) @@ -253,15 +238,7 @@ from the initrd." (define (device-mapping-services os) "Return the list of device-mapping services for OS as a list." - (map (lambda (md) - (let* ((source (mapped-device-source md)) - (target (mapped-device-target md)) - (type (mapped-device-type md)) - (open (mapped-device-kind-open type)) - (close (mapped-device-kind-close type))) - (device-mapping-service target - (open source target) - (close source target)))) + (map device-mapping-service (operating-system-user-mapped-devices os))) (define (swap-services os) @@ -365,7 +342,7 @@ explicitly appear in OS." iproute net-tools ; XXX: remove when Inetutils suffices man-db - texinfo ;for the standalone Info reader + info-reader ;the standalone Info reader (no Perl) ;; The 'sudo' command is already in %SETUID-PROGRAMS, but we also ;; want the other commands and the man pages (notably because @@ -374,7 +351,7 @@ explicitly appear in OS." ;; Get 'insmod' & co. from kmod, not module-init-tools, since udev ;; already depends on it anyway. - kmod eudev-with-blkid + kmod eudev e2fsprogs kbd @@ -400,37 +377,11 @@ This is the GNU system. Welcome.\n") "Return the default /etc/hosts file." (plain-file "hosts" (local-host-aliases host-name))) -(define (emacs-site-file) - "Return the Emacs 'site-start.el' file. That file contains the necessary -settings for 'guix.el' to work out-of-the-box." - (scheme-file "site-start.el" - #~(progn - ;; Add the "normal" elisp directory to the search path; - ;; guix.el may be there. - (add-to-list - 'load-path - "/run/current-system/profile/share/emacs/site-lisp") - - ;; Attempt to load guix.el. - (require 'guix-init nil t) - - ;; Attempt to load geiser. - (require 'geiser-install nil t)))) - -(define (emacs-site-directory) - "Return the Emacs site directory, aka. /etc/emacs." - (computed-file "emacs" - #~(begin - (mkdir #$output) - (chdir #$output) - (symlink #$(emacs-site-file) "site-start.el")))) - (define* (operating-system-etc-service os) "Return a that builds containing the static part of the /etc directory." (let ((login.defs (plain-file "login.defs" "# Empty for now.\n")) - (emacs (emacs-site-directory)) (issue (plain-file "issue" (operating-system-issue os))) (nsswitch (plain-file "nsswitch.conf" (name-service-switch->string @@ -457,6 +408,17 @@ GUIX_PROFILE=/run/current-system/profile \\ # Prepend setuid programs. export PATH=/run/setuid-programs:$PATH +# Since 'lshd' does not use pam_env, /etc/environment must be explicitly +# loaded when someone logs in via SSH. See . +# We need 'PATH' to be defined here, for 'cat' and 'cut'. Do this before +# reading the user's 'etc/profile' to allow variables to be overridden. +if [ -f /etc/environment -a -n \"$SSH_CLIENT\" \\ + -a -z \"$LINUX_MODULE_DIRECTORY\" ] +then + . /etc/environment + export `cat /etc/environment | cut -d= -f1` +fi + if [ -f \"$HOME/.guix-profile/etc/profile\" ] then # Load the user profile's settings. @@ -468,16 +430,6 @@ else export PATH=\"$HOME/.guix-profile/bin:$PATH\" fi -# Since 'lshd' does not use pam_env, /etc/environment must be explicitly -# loaded when someone logs in via SSH. See . -# We need 'PATH' to be defined here, for 'cat' and 'cut'. -if [ -f /etc/environment -a -n \"$SSH_CLIENT\" \\ - -a -z \"$LINUX_MODULE_DIRECTORY\" ] -then - . /etc/environment - export `cat /etc/environment | cut -d= -f1` -fi - # Set the umask, notably for users logging in via 'lsh'. # See . umask 022 @@ -507,7 +459,6 @@ fi\n"))) `(("services" ,#~(string-append #$net-base "/etc/services")) ("protocols" ,#~(string-append #$net-base "/etc/protocols")) ("rpc" ,#~(string-append #$net-base "/etc/rpc")) - ("emacs" ,#~#$emacs) ("login.defs" ,#~#$login.defs) ("issue" ,#~#$issue) ("nsswitch.conf" ,#~#$nsswitch) @@ -587,13 +538,19 @@ use 'plain-file' instead~%") ("SSL_CERT_DIR" . "/etc/ssl/certs") ("SSL_CERT_FILE" . "/etc/ssl/certs/ca-certificates.crt") ("GIT_SSL_CAINFO" . "/etc/ssl/certs/ca-certificates.crt") - ;; Prepend the directory of 'site-start.el' to the search path, so - ;; that it has higher precedence than the 'site-start.el' file our - ;; Emacs package provides. - ("EMACSLOADPATH" . "/etc/emacs:") + + ;; 'GTK_DATA_PREFIX' must name one directory where GTK+ themes are + ;; searched for. + ("GTK_DATA_PREFIX" . "/run/current-system/profile") + ;; By default, applications that use D-Bus, such as Emacs, abort at startup ;; when /etc/machine-id is missing. Make sure these warnings are non-fatal. - ("DBUS_FATAL_WARNINGS" . "0"))) + ("DBUS_FATAL_WARNINGS" . "0") + + ;; XXX: Normally we wouldn't need to do this, but our glibc@2.23 package + ;; looks things up in 'PREFIX/lib/locale' instead of + ;; '/run/current-system/locale' as was intended. + ("GUIX_LOCPATH" . "/run/current-system/locale"))) (define %setuid-programs ;; Default set of setuid-root programs. @@ -632,6 +589,22 @@ hardware-related operations as necessary when booting a Linux container." ;; BOOT is the script as a monadic value. (service-parameters boot))) +(define (operating-system-user-accounts os) + "Return the list of user accounts of OS." + (let* ((services (operating-system-services os)) + (account (fold-services services + #:target-type account-service-type))) + (filter user-account? + (service-parameters account)))) + +(define (operating-system-shepherd-service-names os) + "Return the list of Shepherd service names for OS." + (append-map shepherd-service-provision + (service-parameters + (fold-services (operating-system-services os) + #:target-type + shepherd-root-service-type)))) + (define* (operating-system-derivation os #:key container?) "Return a derivation that builds OS." (let* ((services (operating-system-services os #:container? container?)) @@ -767,7 +740,8 @@ this file is the reconstruction of GRUB menu entries for old configurations." (kernel #$(operating-system-kernel os)) (kernel-arguments #$(operating-system-kernel-arguments os)) - (initrd #$initrd))))) + (initrd #$initrd)) + #:set-load-path? #f))) ;;;