diff options
Diffstat (limited to 'gnu/home/services')
| -rw-r--r-- | gnu/home/services/desktop.scm | 12 | ||||
| -rw-r--r-- | gnu/home/services/mcron.scm | 8 | ||||
| -rw-r--r-- | gnu/home/services/pm.scm | 8 | ||||
| -rw-r--r-- | gnu/home/services/shells.scm | 162 | ||||
| -rw-r--r-- | gnu/home/services/shepherd.scm | 9 | ||||
| -rw-r--r-- | gnu/home/services/ssh.scm | 124 | ||||
| -rw-r--r-- | gnu/home/services/xdg.scm | 36 |
7 files changed, 301 insertions, 58 deletions
diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm index 661fe7d283..626918fd9e 100644 --- a/gnu/home/services/desktop.scm +++ b/gnu/home/services/desktop.scm @@ -214,9 +214,9 @@ according to time of day."))) (cons "DBUS_VERBOSE=1" (default-environment-variables)) #:log-file - (format #f "~a/dbus.log" - (or (getenv "XDG_LOG_HOME") - (format #f "~a/.local/var/log" + (format #f "~a/log/dbus.log" + (or (getenv "XDG_STATE_HOME") + (format #f "~a/.local/state" (getenv "HOME")))))) (stop #~(make-kill-destructor))))) @@ -264,10 +264,10 @@ according to time of day."))) (number->string #$(home-unclutter-configuration-idle-timeout config))) #:log-file (string-append - (or (getenv "XDG_LOG_HOME") - (format #f "~a/.local/var/log" + (or (getenv "XDG_STATE_HOME") + (format #f "~a/.local/state" (getenv "HOME"))) - "/unclutter.log")))))) + "/log/unclutter.log")))))) (define home-unclutter-service-type (service-type diff --git a/gnu/home/services/mcron.scm b/gnu/home/services/mcron.scm index 5f35bfe054..f51edd6634 100644 --- a/gnu/home/services/mcron.scm +++ b/gnu/home/services/mcron.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; Copyright © 2021, 2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; @@ -99,10 +99,10 @@ Each message is also prefixed by a timestamp by GNU Shepherd.")) #~()) #$@files) #:log-file (string-append - (or (getenv "XDG_LOG_HOME") - (format #f "~a/.local/var/log" + (or (getenv "XDG_STATE_HOME") + (format #f "~a/.local/state" (getenv "HOME"))) - "/mcron.log"))) + "/log/mcron.log"))) (stop #~(make-kill-destructor)) (actions (list (shepherd-schedule-action mcron files))))))))) diff --git a/gnu/home/services/pm.scm b/gnu/home/services/pm.scm index 5f09941827..d8361fd214 100644 --- a/gnu/home/services/pm.scm +++ b/gnu/home/services/pm.scm @@ -128,10 +128,10 @@ (list "-i") (list))) #:log-file (string-append - (or (getenv "XDG_LOG_HOME") - (format #f "~a/.local/var/log" - (getenv "HOME"))) - "/batsignal.log"))) + (or (getenv "XDG_STATE_HOME") + (format #f "~a/.local/state" + (getenv "HOME"))) + "/log/batsignal.log"))) (stop #~(make-kill-destructor)))))) (define home-batsignal-service-type diff --git a/gnu/home/services/shells.scm b/gnu/home/services/shells.scm index f05f2221d6..7960590e7c 100644 --- a/gnu/home/services/shells.scm +++ b/gnu/home/services/shells.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. ;;; @@ -44,7 +45,10 @@ home-fish-service-type home-fish-configuration - home-fish-extension)) + home-fish-extension + + home-inputrc-service-type + home-inputrc-configuration)) ;;; Commentary: ;;; @@ -309,16 +313,24 @@ source ~/.profile ;;; (define (bash-serialize-aliases field-name val) - #~(string-append - #$@(map - (match-lambda - ((key . #f) - "") - ((key . #t) - #~(string-append "alias " #$key "\n")) - ((key . value) - #~(string-append "alias " #$key "=\"" #$value "\"\n"))) - val))) + (with-shell-quotation-bindings + #~(string-append + #$@(map + (match-lambda + ((key . #f) + "") + ((key . #t) + #~(string-append "alias " #$key "\n")) + ((key . (? literal-string? value)) + #~(string-append "alias " #$key "=" + (shell-single-quote + #$(literal-string-value value)) + "\n")) + ((key . value) + #~(string-append "alias " #$key "=" + (shell-double-quote #$value) + "\n"))) + val)))) (define-configuration home-bash-configuration (package @@ -626,6 +638,134 @@ end\n\n") (description "\ Install and configure Fish, the friendly interactive shell."))) + +;;; +;;; Readline. +;;; + +(define (serialize-inputrc-key-bindings field-name val) + #~(string-append + #$@(map + (match-lambda + ((key . value) + #~(string-append #$key ": " #$value "\n"))) + val))) + +(define (serialize-inputrc-variables field-name val) + #~(string-append + #$@(map + (match-lambda + ((key . #f) + #~(string-append "set " #$key " off\n")) + ((key . #t) + #~(string-append "set " #$key " on\n")) + ((key . value) + #~(string-append "set " #$key " " #$value "\n"))) + val))) + +(define (serialize-inputrc-conditional-constructs field-name val) + #~(string-append + #$@(map + (match-lambda + (("$endif" . _) + "$endif\n") + (("$include" . value) + #~(string-append "$include " #$value "\n")) + ;; TODO: key can only be "$if" or "$else". + ((key . value) + #~(string-append #$key "\n" + #$(serialize-configuration + value + home-inputrc-configuration-fields)))) + val))) + +(define (serialize-inputrc-extra-content field-name value) + #~(if (string=? #$value "") "" (string-append #$value "\n"))) + +(define-configuration home-inputrc-configuration + (key-bindings + (alist '()) + "Association list of readline key bindings to be added to the +@code{~/.inputrc} file. This is where code like this: + +@lisp +'((\"Control-l\" . \"clear-screen\")) +@end lisp + +turns into + +@example +Control-l: clear-screen +@end example" + (serializer serialize-inputrc-key-bindings)) + (variables + (alist '()) + "Association list of readline variables to set. This is where configuration +options like this: + +@lisp +'((\"bell-style\" . \"visible\") + (\"colored-completion-prefix\" . #t)) +@end lisp + +turns into + +@example +set bell-style visible +set colored-completion-prefix on +@end example" + (serializer serialize-inputrc-variables)) + (conditional-constructs + (alist '()) + "Association list of conditionals to add to the initialization file. This +includes @command{$if}, @command{else}, @command{endif} and @command{include} +and they receive a value of another @command{home-inputrc-configuration}. + +@lisp +(conditional-constructs + `((\"$if mode=vi\" . + ,(home-inputrc-configuration + (variables + `((\"show-mode-in-prompt\" . #t))))) + (\"$else\" . + ,(home-inputrc-configuration + (key-bindings + `((\"Control-l\" . \"clear-screen\"))))) + (\"$endif\" . #t))) +@end lisp + +turns into + +@example +$if mode=vi +set show-mode-in-prompt on +$else +Control-l: clear-screen +$endif +@end example" + (serializer serialize-inputrc-conditional-constructs)) + (extra-content + (string "") + "Extra content appended as-is to the configuration file. Run @command{man +readline} for more information about all the configuration options." + (serializer serialize-inputrc-extra-content))) + +(define (home-inputrc-files config) + (list + `(".inputrc" + ,(mixed-text-file "inputrc" + (serialize-configuration + config + home-inputrc-configuration-fields))))) + +(define home-inputrc-service-type + (service-type (name 'inputrc) + (extensions + (list (service-extension home-files-service-type + home-inputrc-files))) + (default-value (home-inputrc-configuration)) + (description "Configure readline in @code{.inputrc}."))) + (define (generate-home-shell-profile-documentation) (generate-documentation diff --git a/gnu/home/services/shepherd.scm b/gnu/home/services/shepherd.scm index ff6d629114..5585ef61b2 100644 --- a/gnu/home/services/shepherd.scm +++ b/gnu/home/services/shepherd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; Copyright © 2021, 2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; ;;; This file is part of GNU Guix. @@ -108,9 +108,10 @@ as shepherd package." (or (getenv "XDG_RUNTIME_DIR") (format #f "/run/user/~a" (getuid))) "/shepherd/socket")) - (let ((log-dir (or (getenv "XDG_LOG_HOME") - (format #f "~a/.local/var/log" - (getenv "HOME"))))) + (let* ((state-dir (or (getenv "XDG_STATE_HOME") + (format #f "~a/.local/state" + (getenv "HOME")))) + (log-dir (string-append state-dir "/log"))) ;; TODO: Remove it, 0.9.2 creates it automatically? ((@ (guix build utils) mkdir-p) log-dir) (system* diff --git a/gnu/home/services/ssh.scm b/gnu/home/services/ssh.scm index 628dc743ae..ac72129b6c 100644 --- a/gnu/home/services/ssh.scm +++ b/gnu/home/services/ssh.scm @@ -1,6 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr> +;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,14 +40,23 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) + #:autoload (ice-9 regex) (string-match match:substring) #:export (home-openssh-configuration home-openssh-configuration-authorized-keys home-openssh-configuration-known-hosts home-openssh-configuration-hosts + home-openssh-configuration-add-keys-to-agent + home-openssh-configuration? + home-ssh-agent-configuration + home-ssh-agent-openssh + home-ssh-agent-socket-directory + home-ssh-agent-extra-options + home-ssh-agent-configuration? openssh-host openssh-host-host-name + openssh-host-match-criteria openssh-host-identity-file openssh-host-name openssh-host-port @@ -93,7 +104,11 @@ (cond ((= family AF_INET) "inet") ((= family AF_INET6) "inet6") ;; The 'else' branch is unreachable. - (else (raise (condition (&error))))) + (else + (raise + (formatted-message + (G_ "~s: invalid address family value") + family)))) "\n") "")) @@ -104,6 +119,8 @@ (string-append " " (serialize-field-name field) " " (number->string value) "\n")) +(define-maybe boolean) + (define (serialize-boolean field value) (string-append " " (serialize-field-name field) " " (if value "yes" "no") "\n")) @@ -171,13 +188,40 @@ (configuration-field-error (source-properties->location properties) 'proxy-command value)) value)) +(define ssh-match-keywords + '(canonical final exec host originalhost user localuser)) + +(define (match-criteria? str) + ;; Rule out the case of "all" keyword. + (if (member str '("all" + "canonical all" + "final all")) + #t + (let* ((first (string-take str (string-index str #\ ))) + (keyword (string->symbol (if (string-prefix? "!" first) + (string-drop first 1) + first)))) + (memq keyword ssh-match-keywords)))) + +(define-maybe match-criteria) + (define-configuration openssh-host (name - (string) - "Name of this host declaration.") + maybe-string + "Name of this host declaration. A @code{openssh-host} must define only +@code{name} or @code{match-criteria}. Use host-name @code{\"*\"} for +top-level options.") (host-name maybe-string "Host name---e.g., @code{\"foo.example.org\"} or @code{\"192.168.1.2\"}.") + (match-criteria ;TODO implement stricter match-criteria rules + maybe-match-criteria + "When specified, this string denotes the set of hosts to which the entry +applies, superseding the @code{host-name} field. Its first element must be +all or one of @code{ssh-match-keywords}. The rest of the elements are +arguments for the keyword, or other criteria. A @code{openssh-host} must +define only @code{name} or @code{match-criteria}. Other host configuration +options will apply to all hosts matching @code{match-criteria}.") (address-family maybe-address-family "Address family to use when connecting to this host: one of @@ -194,19 +238,19 @@ Additionally, the field can be left unset to allow any address family.") maybe-string "User name on the remote host.") (forward-x11? - (boolean #f) + maybe-boolean "Whether to forward remote client connections to the local X11 graphical display.") (forward-x11-trusted? - (boolean #f) + maybe-boolean "Whether remote X11 clients have full access to the original X11 graphical display.") (forward-agent? - (boolean #f) + maybe-boolean "Whether the authentication agent (if any) is forwarded to the remote machine.") (compression? - (boolean #f) + maybe-boolean "Whether to compress data in transit.") (proxy-command maybe-string @@ -232,33 +276,73 @@ through before connecting to the server.") @file{~/.ssh/config}.")) (define (serialize-openssh-host config) - (define (openssh-host-name-field? field) - (eq? (configuration-field-name field) 'name)) + (define (openssh-host-name-or-match-field? field) + (or (eq? (configuration-field-name field) 'name) + (eq? (configuration-field-name field) 'match-criteria))) (string-append - "Host " (openssh-host-name config) "\n" + (if (maybe-value-set? (openssh-host-name config)) + (if (maybe-value-set? (openssh-host-match-criteria config)) + (raise + (formatted-message + (G_ "define either 'name' or 'match-criteria', not both"))) + (string-append "Host " (openssh-host-name config) "\n")) + (if (maybe-value-set? (openssh-host-match-criteria config)) + (string-append + "Match " (string-join (openssh-host-match-criteria config) " ") "\n") + (raise + (formatted-message + (G_ "define either 'name' or 'match-criteria' once"))))) (string-concatenate (map (lambda (field) ((configuration-field-serializer field) (configuration-field-name field) ((configuration-field-getter field) config))) - (remove openssh-host-name-field? + (remove openssh-host-name-or-match-field? openssh-host-fields))))) (define-record-type* <home-openssh-configuration> home-openssh-configuration make-home-openssh-configuration home-openssh-configuration? - (authorized-keys home-openssh-configuration-authorized-keys ;list of file-like - (default #f)) - (known-hosts home-openssh-configuration-known-hosts ;unspec | list of file-like - (default *unspecified*)) - (hosts home-openssh-configuration-hosts ;list of <openssh-host> - (default '()))) + (authorized-keys home-openssh-configuration-authorized-keys ;list of file-like + (default #f)) + (known-hosts home-openssh-configuration-known-hosts ;unspec | list of file-like + (default *unspecified*)) + (hosts home-openssh-configuration-hosts ;list of <openssh-host> + (default '())) + (add-keys-to-agent home-openssh-configuration-add-keys-to-agent ;string with limited values + (default "no"))) + +(define (serialize-add-keys-to-agent value) + (define (valid-time-string? str) + (and (> (string-length str) 0) + (equal? + str + (match:substring + (string-match "\ +[0-9]+|([0-9]+[Ww])?([0-9]+[Dd])?([0-9]+[Hh])?([0-9]+[Mm])?([0-9]+[Ss])?" + str))))) + + (string-append "AddKeysToAgent " + (cond ((member value '("yes" "no" "confirm" "ask")) value) + ((valid-time-string? value) value) + ((and (string-prefix? "confirm" value) + (valid-time-string? + (cdr (string-split value #\ )))) value) + ;; The 'else' branch is unreachable. + (else + (raise + (formatted-message + (G_ "~s: invalid 'add-keys-to-agent' value") + value)))))) (define (openssh-configuration->string config) - (string-join (map serialize-openssh-host - (home-openssh-configuration-hosts config)) - "\n")) + (string-join + (cons* (serialize-add-keys-to-agent + (home-openssh-configuration-add-keys-to-agent config)) + (map serialize-openssh-host + (home-openssh-configuration-hosts config))) + "\n")) (define* (file-join name files #:optional (delimiter " ")) "Return a file in the store called @var{name} that is the concatenation diff --git a/gnu/home/services/xdg.scm b/gnu/home/services/xdg.scm index ac557b4c3d..958772696b 100644 --- a/gnu/home/services/xdg.scm +++ b/gnu/home/services/xdg.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021, 2022 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +23,7 @@ #:use-module (gnu home services) #:use-module (gnu packages freedesktop) #:use-module (gnu home services utils) + #:use-module (guix deprecation) #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix records) @@ -39,7 +41,7 @@ home-xdg-base-directories-configuration-config-home home-xdg-base-directories-configuration-data-home home-xdg-base-directories-configuration-state-home - home-xdg-base-directories-configuration-log-home + home-xdg-base-directories-configuration-log-home ; deprecated home-xdg-base-directories-configuration-runtime-dir home-xdg-user-directories-service-type @@ -77,6 +79,7 @@ (define (serialize-path field-name val) "") (define path? string?) +(define-maybe path) (define-configuration home-xdg-base-directories-configuration (cache-home @@ -97,12 +100,17 @@ read-only shared data, analogus to @file{/usr/share}, but for user.") (path "${XDG_RUNTIME_DIR:-/run/user/$UID}") "Base directory for programs to store user-specific runtime files, like sockets.") + ;; TODO: deprecated field, use $XDG_STATE_HOME(/log) instead. (log-home - (path "$HOME/.local/var/log") + maybe-path "Base directory for programs to store log files, analogus to @file{/var/log}, but for user. It is not a part of XDG Base Directory Specification, but helps to make implementation of home services more -consistent.") +consistent." + (lambda (field-name val) + (when (maybe-value-set? val) + (warn-about-deprecation field-name #f #:replacement 'state-home)) + (serialize-path field-name val))) (state-home (path "$HOME/.local/state") "Base directory for programs to store state data that should persist @@ -117,7 +125,13 @@ portable enough to the user to warrant storing them in #f "XDG_~a" (object->snake-case-string (configuration-field-name field) 'upper)) ((configuration-field-getter field) config))) - home-xdg-base-directories-configuration-fields)) + ;; XXX: deprecated field, remove later + (if (maybe-value-set? + (home-xdg-base-directories-configuration-log-home config)) + home-xdg-base-directories-configuration-fields + (filter-configuration-fields + home-xdg-base-directories-configuration-fields + '(log-home) #t)))) (define (ensure-xdg-base-dirs-on-activation config) (with-imported-modules '((guix build utils)) @@ -138,7 +152,14 @@ portable enough to the user to warrant storing them in ;; and will be provided by elogind or other service. (and (not (string=? "XDG_RUNTIME_DIR" variable)) variable))) - home-xdg-base-directories-configuration-fields))))) + ;; XXX: deprecated field, remove later + (if (maybe-value-set? + (home-xdg-base-directories-configuration-log-home + config)) + home-xdg-base-directories-configuration-fields + (filter-configuration-fields + home-xdg-base-directories-configuration-fields + '(log-home) #t))))))) (define (last-extension-or-cfg config extensions) "Picks configuration value from last provided extension. If there @@ -157,10 +178,7 @@ are no extensions use configuration instead." (default-value (home-xdg-base-directories-configuration)) (compose identity) (extend last-extension-or-cfg) - (description "Configure XDG base directories. This -service introduces an additional @env{XDG_LOG_HOME} variable. It's not -a part of XDG specification, at least yet, but are convenient to have, -it improves the consistency between different home services. The + (description "Configure XDG base directories. The services of this service-type is instantiated by default, to provide non-default value, extend the service-type (using @code{simple-service} for example)."))) |