diff options
Diffstat (limited to 'gnu/services/base.scm')
| -rw-r--r-- | gnu/services/base.scm | 186 |
1 files changed, 75 insertions, 111 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 24b3ea785b..50865055fe 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -12,8 +12,10 @@ ;;; Copyright © 2019 John Soo <[email protected]> ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <[email protected]> ;;; Copyright © 2020 Florian Pelz <[email protected]> -;;; Copyright © 2020 Brice Waegeneire <[email protected]> +;;; Copyright © 2020, 2021 Brice Waegeneire <[email protected]> ;;; Copyright © 2021 qblade <[email protected]> +;;; Copyright © 2021 Hui Lu <[email protected]> +;;; Copyright © 2021 Maxim Cournoyer <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -41,6 +43,7 @@ #:use-module (gnu system shadow) ; 'user-account', etc. #:use-module (gnu system uuid) #:use-module (gnu system file-systems) ; 'file-system', etc. + #:use-module (gnu system keyboard) #:use-module (gnu system mapped-devices) #:use-module ((gnu system linux-initrd) #:select (file-system-packages)) @@ -71,7 +74,6 @@ file-system-service-type swap-service host-name-service - console-keymap-service %default-console-font console-font-service-type console-font-service @@ -151,7 +153,6 @@ guix-configuration-extra-options guix-configuration-log-file - guix-service guix-service-type guix-publish-configuration guix-publish-configuration? @@ -163,16 +164,13 @@ guix-publish-configuration-nar-path guix-publish-configuration-cache guix-publish-configuration-ttl - guix-publish-service guix-publish-service-type gpm-configuration gpm-configuration? gpm-service-type - gpm-service urandom-seed-service-type - urandom-seed-service rngd-configuration rngd-configuration? @@ -314,17 +312,20 @@ FILE-SYSTEM." (define (file-system-shepherd-service file-system) "Return the shepherd service for @var{file-system}, or @code{#f} if -@var{file-system} is not auto-mounted upon boot." +@var{file-system} is not auto-mounted or doesn't have its mount point created +upon boot." (let ((target (file-system-mount-point file-system)) (create? (file-system-create-mount-point? file-system)) + (mount? (file-system-mount? file-system)) (dependencies (file-system-dependencies file-system)) (packages (file-system-packages (list file-system)))) - (and (file-system-mount? file-system) + (and (or mount? create?) (with-imported-modules (source-module-closure '((gnu build file-systems))) (shepherd-service (provision (list (file-system->shepherd-service-name file-system))) - (requirement `(root-file-system udev + (requirement `(root-file-system + udev ,@(map dependency->shepherd-service-name dependencies))) (documentation "Check, mount, and unmount the given file system.") (start #~(lambda args @@ -332,24 +333,26 @@ FILE-SYSTEM." #~(mkdir-p #$target) #t) - (let (($PATH (getenv "PATH"))) - ;; Make sure fsck.ext2 & co. can be found. - (dynamic-wind - (lambda () - ;; Don’t display the PATH settings. - (with-output-to-port (%make-void-port "w") - (lambda () - (set-path-environment-variable "PATH" - '("bin" "sbin") - '#$packages)))) - (lambda () - (mount-file-system - (spec->file-system - '#$(file-system->spec file-system)) - #:root "/")) - (lambda () - (setenv "PATH" $PATH))) - #t))) + #$(if mount? + #~(let (($PATH (getenv "PATH"))) + ;; Make sure fsck.ext2 & co. can be found. + (dynamic-wind + (lambda () + ;; Don’t display the PATH settings. + (with-output-to-port (%make-void-port "w") + (lambda () + (set-path-environment-variable "PATH" + '("bin" "sbin") + '#$packages)))) + (lambda () + (mount-file-system + (spec->file-system + '#$(file-system->spec file-system)) + #:root "/")) + (lambda () + (setenv "PATH" $PATH)))) + #t) + #t)) (stop #~(lambda args ;; Normally there are no processes left at this point, so ;; TARGET can be safely unmounted. @@ -368,7 +371,10 @@ FILE-SYSTEM." (define (file-system-shepherd-services file-systems) "Return the list of Shepherd services for FILE-SYSTEMS." - (let* ((file-systems (filter file-system-mount? file-systems))) + (let* ((file-systems (filter (lambda (x) + (or (file-system-mount? x) + (file-system-create-mount-point? x))) + file-systems))) (define sink (shepherd-service (provision '(file-systems)) @@ -543,10 +549,6 @@ file systems, as well as corresponding @file{/etc/fstab} entries."))) generator (RNG) with the value recorded when the system was last shut down."))) -(define-deprecated (urandom-seed-service) - urandom-seed-service-type - (service urandom-seed-service-type)) - ;;; ;;; Add hardware random number generator to entropy pool. @@ -651,11 +653,6 @@ to add @var{device} to the kernel's entropy pool. The service will fail if @code{keyboard-layout} field of @code{operating-system}.} Load the given list of console keymaps with @command{loadkeys}."))) -(define-deprecated (console-keymap-service #:rest files) - #f - "Return a service to load console keymaps from @var{files}." - (service console-keymap-service-type files)) - (define %default-console-font ;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common ;; scripts as well as glyphs for em dash, quotation marks, and other Unicode @@ -1395,14 +1392,8 @@ information on the configuration file syntax." (let ((security-limits ;; Create /etc/security containing the provided "limits.conf" file. (lambda (limits-file) - `(("security" - ,(computed-file - "security" - #~(begin - (mkdir #$output) - (stat #$limits-file) - (symlink #$limits-file - (string-append #$output "/limits.conf")))))))) + `(("security/limits.conf" + ,limits-file)))) (pam-extension (lambda (pam) (let ((pam-limits (pam-entry @@ -1516,7 +1507,8 @@ archive' public keys, with GUIX." (define %default-authorized-guix-keys ;; List of authorized substitute keys. - (list (file-append guix "/share/guix/berlin.guix.gnu.org.pub"))) + (list (file-append guix "/share/guix/berlin.guix.gnu.org.pub") + (file-append guix "/share/guix/bordeaux.guix.gnu.org.pub"))) (define-record-type* <guix-configuration> guix-configuration make-guix-configuration @@ -1711,21 +1703,21 @@ proxy of 'guix-daemon'...~%") (define (guix-activation config) "Return the activation gexp for CONFIG." - (match config - (($ <guix-configuration> guix build-group build-accounts authorize-key? keys) - ;; Assume that the store has BUILD-GROUP as its group. We could - ;; otherwise call 'chown' here, but the problem is that on a COW overlayfs, - ;; chown leads to an entire copy of the tree, which is a bad idea. + (match-record config <guix-configuration> + (guix authorize-key? authorized-keys) + #~(begin + ;; Assume that the store has BUILD-GROUP as its group. We could + ;; otherwise call 'chown' here, but the problem is that on a COW overlayfs, + ;; chown leads to an entire copy of the tree, which is a bad idea. - ;; Generate a key pair and optionally authorize substitute server keys. - #~(begin - (unless (file-exists? "/etc/guix/signing-key.pub") - (system* #$(file-append guix "/bin/guix") "archive" - "--generate-key")) + ;; Generate a key pair and optionally authorize substitute server keys. + (unless (file-exists? "/etc/guix/signing-key.pub") + (system* #$(file-append guix "/bin/guix") "archive" + "--generate-key")) - #$(if authorize-key? - (substitute-key-authorization keys guix) - #~#f))))) + #$(if authorize-key? + (substitute-key-authorization authorized-keys guix) + #~#f)))) (define* (references-file item #:optional (name "references")) "Return a file that contains the list of references of ITEM." @@ -1770,13 +1762,6 @@ proxy of 'guix-daemon'...~%") (description "Run the build daemon of GNU@tie{}Guix, aka. @command{guix-daemon}."))) -(define-deprecated (guix-service #:optional - (config %default-guix-configuration)) - guix-service-type - "Return a service that runs the Guix build daemon according to -@var{config}." - (service guix-service-type config)) - (define-record-type* <guix-publish-configuration> guix-publish-configuration make-guix-publish-configuration @@ -1928,19 +1913,6 @@ raise a deprecation warning if the 'compression-level' field was used." "Add a Shepherd service running @command{guix publish}, a command that allows you to share pre-built binaries with others over HTTP."))) -(define-deprecated (guix-publish-service #:key (guix guix) - (port 80) (host "localhost")) - guix-publish-service-type - "Return a service that runs @command{guix publish} listening on @var{host} -and @var{port} (@pxref{Invoking guix publish}). - -This assumes that @file{/etc/guix} already contains a signing key pair as -created by @command{guix archive --generate-key} (@pxref{Invoking guix -archive}). If that is not the case, the service will fail to start." - ;; Deprecated. - (service guix-publish-service-type - (guix-publish-configuration (guix guix) (port port) (host host)))) - ;;; ;;; Udev. @@ -2248,23 +2220,13 @@ instance." (list (shepherd-service (requirement '(udev)) (provision '(gpm)) - (start #~(lambda () - ;; 'gpm' runs in the background and sets a PID file. - ;; Note that it requires running as "root". - (false-if-exception (delete-file "/var/run/gpm.pid")) - (fork+exec-command (list #$(file-append gpm "/sbin/gpm") - #$@options)) - - ;; Wait for the PID file to appear; declare failure if - ;; it doesn't show up. - (let loop ((i 3)) - (or (file-exists? "/var/run/gpm.pid") - (if (zero? i) - #f - (begin - (sleep 1) - (loop (1- i)))))))) - + ;; 'gpm' runs in the background and sets a PID file. + ;; Note that it requires running as "root". + (start #~(make-forkexec-constructor + (list #$(file-append gpm "/sbin/gpm") + #$@options) + #:pid-file "/var/run/gpm.pid" + #:pid-file-timeout 3)) (stop #~(lambda (_) ;; Return #f if successfully stopped. (not (zero? (system* #$(file-append gpm "/sbin/gpm") @@ -2282,19 +2244,6 @@ command-line options. GPM allows users to use the mouse in the console, notably to select, copy, and paste text. The default options use the @code{ps2} protocol, which works for both USB and PS/2 mice."))) -(define-deprecated (gpm-service #:key (gpm gpm) - (options %default-gpm-options)) - gpm-service-type - "Run @var{gpm}, the general-purpose mouse daemon, with the given -command-line @var{options}. GPM allows users to use the mouse in the console, -notably to select, copy, and paste text. The default value of @var{options} -uses the @code{ps2} protocol, which works for both USB and PS/2 mice. - -This service is not part of @var{%base-services}." - ;; To test in QEMU, use "-usbdevice mouse" and then, in the monitor, use - ;; "info mice" and "mouse_set X" to use the right mouse. - (service gpm-service-type - (gpm-configuration (gpm gpm) (options options)))) (define-record-type* <kmscon-configuration> kmscon-configuration make-kmscon-configuration @@ -2313,7 +2262,9 @@ This service is not part of @var{%base-services}." (font-engine kmscon-configuration-font-engine (default "pango")) (font-size kmscon-configuration-font-size - (default 12))) + (default 12)) + (keyboard-layout kmscon-configuration-keyboard-layout + (default #f))) ; #f | <keyboard-layout> (define kmscon-service-type (shepherd-service-type @@ -2326,7 +2277,8 @@ This service is not part of @var{%base-services}." (auto-login (kmscon-configuration-auto-login config)) (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config)) (font-engine (kmscon-configuration-font-engine config)) - (font-size (kmscon-configuration-font-size config))) + (font-size (kmscon-configuration-font-size config)) + (keyboard-layout (kmscon-configuration-keyboard-layout config))) (define kmscon-command #~(list @@ -2335,6 +2287,18 @@ This service is not part of @var{%base-services}." "--no-switchvt" ;Prevent a switch to the virtual terminal. "--font-engine" #$font-engine "--font-size" #$(number->string font-size) + #$@(if keyboard-layout + (let* ((layout (keyboard-layout-name keyboard-layout)) + (variant (keyboard-layout-variant keyboard-layout)) + (model (keyboard-layout-model keyboard-layout)) + (options (keyboard-layout-options keyboard-layout))) + `("--xkb-layout" ,layout + ,@(if variant `("--xkb-variant" ,variant) '()) + ,@(if model `("--xkb-model" ,model) '()) + ,@(if (null? options) + '() + `("--xkb-options" ,(string-join options ","))))) + '()) #$@(if hardware-acceleration? '("--hwaccel") '()) "--login" "--" #$login-program #$@login-arguments |